home *** CD-ROM | disk | FTP | other *** search
/ IRIX Installation Tools & Overlays 2002 November / SGI IRIX Installation Tools & Overlays 2002 November - Disc 4.iso / dist / infosearch.idb / usr / lib / infosearch / bin / mknmz.z / mknmz
Text File  |  2002-10-15  |  69KB  |  2,473 lines
  1. #! /usr/bin/perl5 -w
  2. # -*- Perl -*-
  3. # mknmz - indexer of Namazu
  4. # $Id: mknmz,v 1.1 2002/08/14 15:51:10 agd Exp $
  5. #
  6. # Copyright (C) 1997-1999 Satoru Takabayashi All rights reserved.
  7. # Copyright (C) 2000,2001 Namazu Project All rights reserved.
  8. #     This is free software with ABSOLUTELY NO WARRANTY.
  9. #
  10. #  This program is free software; you can redistribute it and/or modify
  11. #  it under the terms of the GNU General Public License as published by
  12. #  the Free Software Foundation; either versions 2, or (at your option)
  13. #  any later version.
  14. # 
  15. #  This program is distributed in the hope that it will be useful
  16. #  but WITHOUT ANY WARRANTY; without even the implied warranty of
  17. #  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  18. #  GNU General Public License for more details.
  19. #
  20. #  You should have received a copy of the GNU General Public License
  21. #  along with this program; if not, write to the Free Software
  22. #  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
  23. #  02111-1307, USA
  24. #
  25. #  This file must be encoded in EUC-JP encoding
  26. #
  27.  
  28. package mknmz;
  29. require 5.004;
  30. use lib ".";
  31. use Cwd;
  32. use IO::File;
  33. use File::Find;
  34. require "/usr/lib/infosearch/l10n/namazu/pm/MMagic.pm";
  35. #use File::MMagic;
  36. use Time::Local;
  37. use strict;  # be strict since v1.2.0
  38. use Getopt::Long;
  39. use File::Copy;
  40. use DirHandle;
  41.  
  42. use vars qw($SYSTEM);
  43. $SYSTEM = $^O;
  44.  
  45. my $NAMAZU_INDEX_VERSION = "2.0";
  46.  
  47. my $CodingSystem = "euc";
  48. my $PKGDATADIR    = $ENV{'pkgdatadir'} || "/usr/lib/infosearch/l10n/namazu";
  49. my $CONFDIR       = "/usr/lib/infosearch/l10n/namazu/etc";     # directory where mknmzrc are in.
  50. my $LIBDIR        = $PKGDATADIR . "/pl";      # directory where library etc. are in.
  51. my $FILTERDIR     = $PKGDATADIR . "/filter";   # directory where filters are in.
  52. my $TEMPLATEDIR   = $PKGDATADIR . "/template"; # directory where templates are in.
  53.  
  54. my $DeletedFilesCount = 0;
  55. my $UpdatedFilesCount = 0;
  56. my $APPENDMODE = 0;
  57. my %PhraseHash = ();
  58. my %PhraseHashLast = ();
  59. my %KeyIndex = ();
  60. my %KeyIndexLast = ();
  61. my %CheckPoint = ("on" => undef, "continue" => undef);
  62. my $ConfigFile = undef;
  63. my $MediaType  = undef;
  64.  
  65. my $ReplaceCode  = undef;  # perl code for transforming URI
  66. my @Seed = ();
  67. my @LoadedRcfiles = ();
  68. my $Magic = new File::MMagic;
  69.  
  70. my $ReceiveTERM = 0;
  71.  
  72. STDOUT->autoflush(1);
  73. STDERR->autoflush(1);
  74. main();
  75. sub main {
  76.     my $start_time = time;
  77.  
  78.     init();
  79.  
  80.     # At first, loading pl/conf.pl to prevent overriding some variables.
  81.     preload_modules();
  82.  
  83.     # set LANG and bind textdomain
  84.     util::set_lang();
  85.     textdomain('namazu', $util::LANG_MSG);
  86.  
  87.     load_rcfiles();
  88.     load_modules();
  89.     my ($output_dir, @targets) = parse_options();
  90.     my ($docid_base, $total_files_num) = prep($output_dir, @targets);
  91.  
  92.     my $swap = 1;
  93.     my $docid_count = 0;
  94.     my $file_count = 0;
  95.     my $total_files_size = 0;
  96.     my $key_count = 0;
  97.     my $checkpoint = 0;
  98.     my $flist_ptr = 0;
  99.     my $processed_files_size = 0;
  100.  
  101.     if ($CheckPoint{'continue'}) {
  102.     # Restore variables
  103.     eval util::readfile($var::NMZ{'_checkpoint'}) ;
  104.     } else {
  105.     print $total_files_num . _(" files are found to be indexed.\n");
  106.     }
  107.  
  108.     {
  109.     my $fh_errorsfile = util::efopen(">>$var::NMZ{'err'}");
  110.     my $fh_flist = util::efopen($var::NMZ{'_flist'});
  111.     my %field_indices = ();
  112.     get_field_index_base(\%field_indices);
  113.  
  114.     if ($CheckPoint{'continue'}) {
  115.         seek($fh_flist, $flist_ptr, 0);
  116.     }
  117.  
  118.     # Process target files one by one
  119.     while (defined(my $line = <$fh_flist>)) {
  120.         $flist_ptr += length($line);
  121.         my $cfile = $line;
  122.         chomp $cfile;
  123.         util::dprint(_("target file: ")."$cfile\n");
  124.  
  125.         my ($cfile_size, $num) = 
  126.         process_file($cfile, $docid_count, $docid_base, 
  127.                  $file_count, \%field_indices,
  128.                  $fh_errorsfile, $total_files_num);
  129.         if ($num == 0) {
  130.         $total_files_num--;
  131.         next;
  132.         } else {
  133.         $docid_count += $num;
  134.         $file_count++;
  135.         }
  136.  
  137.         $total_files_size     += $cfile_size;
  138.         $processed_files_size += $cfile_size;
  139.         last if $ReceiveTERM;
  140.         if ($processed_files_size > $conf::ON_MEMORY_MAX) {
  141.         if (%KeyIndex) {
  142.             $key_count = write_index();
  143.             print _("Writing index files..."); 
  144.             write_phrase_hash();
  145.             print "\n";
  146.         }
  147.         $processed_files_size = 0;
  148.         $checkpoint = 1, last if $CheckPoint{'on'} && defined(<$fh_flist>);
  149.         }
  150.     }
  151.     }
  152.     # This should be out of above blocks because of file handler closing.
  153.     re_exec($flist_ptr, $docid_count, $docid_base, $start_time, 
  154.         $total_files_size, $total_files_num,
  155.         $file_count, $key_count) if $checkpoint;
  156.  
  157.     if (%KeyIndex) {
  158.     $key_count = write_index();
  159.     print _("Writing index files...");
  160.     write_phrase_hash();
  161.     print "\n";
  162.     }
  163.  
  164.     $key_count = get_total_keys() unless $key_count;
  165.     do_remain_job($total_files_size, $docid_count, $key_count, 
  166.            $start_time);
  167.     exit 0;
  168. }
  169.  
  170. #
  171. # FIXME: Very complicated.
  172. #
  173. sub process_file ($$$$$$) {
  174.     my ($cfile, $docid_count, $docid_base, $file_count, 
  175.     $field_indices, $fh_errorsfile, $total_files_num) = @_;
  176.  
  177.     my $processed_num = 0;
  178.     my $file_size = util::filesize($cfile);
  179.  
  180.     if ($var::Opt{'htmlsplit'} && $cfile =~ $conf::HTML_SUFFIX) {
  181.     my @parts = htmlsplit::split($cfile, "NMZ.partial");
  182.     if (@parts > 1) {
  183.         my $id = 0;
  184.         for my $part (@parts) {
  185.         my $fname = util::tmpnam("NMZ.partial.$id");
  186.         my $fragment  = defined $part ? $part : undef;
  187.         my $uri   = generate_uri($cfile, $fragment);
  188.         my $result = namazu_core($fname, 
  189.                      $docid_count + $processed_num, 
  190.                      $docid_base, $file_count, 
  191.                      $field_indices, $fh_errorsfile, 
  192.                      $total_files_num, 
  193.                      $uri, $id, $#parts);
  194.         if ($result > 0) {
  195.             $processed_num++;
  196.             my $rname = defined $part ? "$cfile\t$part" : "$cfile";
  197.             put_registry($rname);
  198.         }
  199.             unlink $fname;
  200.         $id++;
  201.         }
  202.         return ($file_size, $processed_num);
  203.     }
  204.     }
  205.     my $result = namazu_core($cfile, $docid_count, $docid_base, 
  206.                  $file_count, $field_indices, 
  207.                  $fh_errorsfile, $total_files_num,
  208.                  undef, undef, undef);
  209.     if ($result > 0) {
  210.     $processed_num++;
  211.     put_registry($cfile);
  212.     }
  213.  
  214.     return ($file_size, $processed_num);
  215. }
  216.  
  217. # 
  218. # Load mknmzrcs:
  219. # 
  220. #  1. MKNMZRC environment
  221. # 
  222. #  2. $(sysconfdir)/$(PACKAGE)/mknmzrc
  223. # 
  224. #  3. ~/.mknmzrc
  225. # 
  226. #  4. user-specified mknmzrc set by mknmz --config=file option.
  227. # 
  228. # If multiple files exists, read all of them.
  229. # 
  230. sub load_rcfiles () {
  231.     my (@cand) = ();
  232.  
  233.     # To support Windows. Since they have nasty drive letter convention,
  234.     # it is necessary to change mknmzrc dynamically with env. variable.
  235.     push @cand, $ENV{'MKNMZRC'} if defined $ENV{'MKNMZRC'};
  236.     push @cand, "$CONFDIR/mknmzrc";
  237.     push @cand, "$ENV{'HOME'}/.mknmzrc";
  238.  
  239.     util::vprint(_("Reading rcfile: "));
  240.     for my $rcfile (@cand) {
  241.     if (-f $rcfile) {
  242.         load_rcfile ($rcfile);
  243.         util::vprint(" $rcfile");
  244.     }
  245.     }
  246.     util::vprint("\n");
  247. }
  248.  
  249. sub load_rcfile ($) {
  250.     my ($rcfile) = @_;
  251.     if ($SYSTEM eq "MSWin32" || $SYSTEM eq "os2") {
  252.     # convert \ to / with consideration for Shift_JIS Kanji code
  253.     $rcfile =~ 
  254.         s!([\x81-\x9f\xe0-\xef][\x40-\x7e\x80-\xfc]|[\x01-\x7f])!
  255.         $1 eq "\\" ? "/" : $1!gex;
  256.     }
  257.     return if (grep {m/^$rcfile$/} @LoadedRcfiles);
  258.     do $rcfile;
  259.     push @LoadedRcfiles, $rcfile;
  260.  
  261.     # Dirty workaround.
  262.     $LIBDIR = $conf::LIBDIR
  263.     if (defined $conf::LIBDIR && -d $conf::LIBDIR);
  264.     $FILTERDIR = $conf::FILTERDIR
  265.     if (defined $conf::FILTERDIR && -d $conf::FILTERDIR);
  266.     $TEMPLATEDIR = $conf::TEMPLATEDIR
  267.     if (defined $conf::TEMPLATEDIR && -d $conf::TEMPLATEDIR);
  268. }
  269.  
  270. sub re_exec($$$$$$$$) {
  271.     my ($flist_ptr, $docid_count, $docid_base, $start_time, 
  272.     $total_files_size, $total_files_num, $file_count, $key_count) = @_;
  273.  
  274.     # store variables
  275.     {
  276.     my $fh_checkpoint = util::efopen(">$var::NMZ{'_checkpoint'}");
  277.  
  278.     print $fh_checkpoint <<EOM;
  279.     \$DeletedFilesCount = $DeletedFilesCount;
  280.     \$UpdatedFilesCount = $UpdatedFilesCount;
  281.     \$APPENDMODE = $APPENDMODE;
  282.     \$flist_ptr = $flist_ptr;
  283.     \$docid_count = $docid_count;
  284.     \$docid_base = $docid_base;
  285.     \$start_time = $start_time;
  286.     \$total_files_size = $total_files_size;
  287.     \$total_files_num = $total_files_num;
  288.     \$key_count = $key_count;
  289.     \$file_count = $file_count;
  290.     \$\$ = $$;
  291. EOM
  292.     }
  293.  
  294.     @ARGV = ("-S", @ARGV) ;
  295.     print _("Checkpoint reached: re-exec mknmz...\n");
  296.     util::dprint(join ' ', ("::::", @ARGV, "\n"));
  297.     exec ($0, @ARGV) ;
  298. }
  299.  
  300. sub put_registry ($) {
  301.     my ($filename) = @_;
  302.     my $fh_registry = util::efopen(">>$var::NMZ{'_r'}");
  303.     print $fh_registry $filename, "\n";
  304. }
  305.  
  306.  
  307. # Initialization
  308. #   $CodingSystem: Character Coding System 'euc' or 'sjis'
  309. sub init () {
  310.     $SYSTEM = $^O;
  311.     if (($SYSTEM eq "MSWin32") || ($SYSTEM eq "os2")) {
  312.     $CodingSystem = "sjis";
  313.     if ($CONFDIR !~ /^[A-Z]:|^\\\\/i && $0 =~ m#^([A-Z]:)(/|\\)#i) {
  314.         $CONFDIR = $1 . $CONFDIR ;
  315.     }
  316.     if ($LIBDIR !~ /^[A-Z]:|^\\\\/i && $0 =~ m#^([A-Z]:)(/|\\)#i) {
  317.         $LIBDIR = $1 . $LIBDIR ;
  318.     }
  319.     if ($FILTERDIR !~ /^[A-Z]:|^\\\\/i && $0 =~ m#^([A-Z]:)(/|\\)#i) {
  320.         $FILTERDIR = $1 . $FILTERDIR ;
  321.     }
  322.     if ($TEMPLATEDIR !~ /^[A-Z]:|^\\\\/i && $0 =~ m#^([A-Z]:)(/|\\)#i) {
  323.         $TEMPLATEDIR = $1 . $TEMPLATEDIR ;
  324.     }
  325.     } else {
  326.     $CodingSystem = "euc";
  327.     }
  328.  
  329.     $SIG{'INT'}  = sub {
  330.     util::cdie("SIGINT caught! Aborted.\n");
  331.     };
  332.  
  333.     $SIG{'TERM'}  = sub {
  334.     print STDERR "SIGTERM caught!\n";
  335.     $ReceiveTERM = 1;
  336.     };
  337. }
  338.  
  339. sub preload_modules () { 
  340.     unshift @INC, $LIBDIR;
  341.     # workaround for test suites.
  342.     unshift @INC, $ENV{'top_builddir'} . "/pl" if defined $ENV{'top_builddir'};
  343.  
  344.     require "conf.pl" || die "unable to require \"conf.pl\"\n";
  345.     require "util.pl" || die "unable to require \"util.pl\"\n";
  346.     require "gettext.pl" || die "unable to require \"gettext.pl\"\n";
  347. }
  348.  
  349. sub postload_modules () {
  350.     require "htmlsplit.pl" || die "unable to require \"htmlsplit.pl\"\n";
  351. }
  352.  
  353. sub load_modules () {
  354.     require "var.pl" || die "unable to require \"var.pl\"\n";
  355.     require "usage.pl" || die "unable to require \"usage.pl\"\n";
  356.     require "codeconv.pl" || die "unable to require \"codeconv.pl\"\n";
  357.     require "wakati.pl" || die "unable to require \"wakati.pl\"\n";
  358.     require "seed.pl" || die "unable to require \"seed.pl\"\n";
  359.     require "gfilter.pl" || die "unable to require \"gfilter.pl\"\n";
  360.  
  361.     @Seed = seed::init();
  362. }
  363.  
  364. sub load_filtermodules () {
  365.     unshift @INC, $FILTERDIR;
  366.  
  367.     #
  368.     # Windows modules must be loaded first.
  369.     # Because OLE filters have low precedence over normal ones.
  370.     #
  371.     load_win32modules() if $SYSTEM eq "MSWin32";
  372.  
  373.     # Check filter modules
  374.     my @filters = ();
  375.     @filters = glob "$FILTERDIR/*.pl";
  376.  
  377.     load_filters(@filters);
  378. }
  379.  
  380. sub load_win32modules () {
  381.     # Check filter modules
  382.     my @filters = ();
  383.     if (-f "../filter/win32/olemsword.pl") { # to ease developing
  384.     @filters = glob "../filter/win32/*.pl";
  385.     unshift @INC, "../filter/win32";
  386.     } else {
  387.     @filters = glob "$FILTERDIR/win32/*.pl";
  388.     unshift @INC, "$FILTERDIR/win32";
  389.     }
  390.  
  391.     load_filters(@filters);
  392. }
  393.  
  394. sub load_filters (@) {
  395.     my @filters = @_;
  396.    
  397.     for my $filter (@filters) {
  398.     $filter =~ m!([-\w]+)\.pl$!;
  399.     my $module = $1;
  400.     require "$module.pl" || die "unable to require \"$module.pl\"\n";;
  401.     my (@mtypes, $status, $recursive, $pre_codeconv, $post_codeconv);
  402.  
  403.     eval "\@mtypes =    ${module}::mediatype();";
  404.     die $@ if $@;  # eval error
  405.     eval "\$status =    ${module}::status();";
  406.     die $@ if $@;
  407.     eval "\$recursive = ${module}::recursive();";
  408.     die $@ if $@;
  409.     eval "\$pre_codeconv  = ${module}::pre_codeconv();";
  410.     die $@ if $@;
  411.     eval "\$post_codeconv  = ${module}::post_codeconv();";
  412.     die $@ if $@;
  413.     eval "${module}::add_magic(\$Magic);";
  414.     die $@ if $@;
  415.  
  416.     for my $mt (@mtypes) {
  417.         next if (defined $var::Supported{$mt} && 
  418.                  $var::Supported{$mt} eq 'yes' && $status eq 'no');
  419.         $var::Supported{$mt} = $status;
  420.         $var::REQUIRE_ACTIONS{$mt} = $module;
  421.         $var::RECURSIVE_ACTIONS{$mt} = $recursive;
  422.         $var::REQUIRE_PRE_CODECONV{$mt} = $pre_codeconv;
  423.         $var::REQUIRE_POST_CODECONV{$mt} = $post_codeconv;
  424.     }
  425.     }
  426. }
  427.  
  428. # Core routine.
  429. #
  430. # FIXME: Too many parameters. They must be cleared.
  431. #
  432. sub namazu_core ($$$$$$$$$$) {
  433.     my ($cfile, $docid_count, $docid_base, 
  434.     $file_count, $field_indices, $fh_errorsfile, $total_files_num,
  435.     $uri, $part_id, $part_num) = @_;
  436.  
  437.     my $headings = "";
  438.     my $content = "";
  439.     my $weighted_str = "";
  440.     my %fields;
  441.     my $msg_prefix;
  442.  
  443.     if ($part_id) {
  444.     $msg_prefix = "    $part_id/$part_num - ";
  445.     } else {
  446.     $msg_prefix = $file_count + 1 . "/$total_files_num - ";
  447.     }
  448.  
  449.     unless ($uri) {
  450.     $uri = generate_uri($cfile);  # Make a URI from a file name.
  451.     }
  452.     my ($cfile_size, $text_size, $kanji, $mtype) = 
  453.     load_document(\$cfile, \$content, \$weighted_str,
  454.               \$headings, \%fields);
  455.  
  456.     util::dprint(_("after load_document: ")."$uri: $cfile_size, $text_size, $kanji, $mtype\n");
  457.  
  458.     # Check if the file is acceptable.
  459.     my $err = check_file($cfile, $cfile_size, $text_size, $mtype, $uri);
  460.     if (defined $err) {
  461.     if (($SYSTEM eq "MSWin32") || ($SYSTEM eq "os2")) {
  462.         my $uri2 = codeconv::eucjp_to_shiftjis($uri);
  463.         print $msg_prefix . "$uri2 $err\n";
  464.     } else {
  465.         print $msg_prefix . "$uri $err\n";
  466.     }
  467.     print $fh_errorsfile "$cfile $err\n"; 
  468.     return 0;  # return 0 if error
  469.     }
  470.  
  471.     # Print processing file name as URI.
  472.     if (($SYSTEM eq "MSWin32") || ($SYSTEM eq "os2")) {
  473.     my $uri2 = codeconv::eucjp_to_shiftjis($uri);
  474.     print $msg_prefix . "$uri2 [$mtype]\n";
  475.     } else {
  476.     print $msg_prefix . "$uri [$mtype]\n";
  477.     }
  478.  
  479.     complete_field_info(\%fields, $cfile, $uri, 
  480.             \$headings, \$content, \$weighted_str);
  481.     put_field_index(\%fields, $field_indices);
  482.  
  483.     put_dateindex($cfile);
  484.     $content .= $weighted_str;   # add weights
  485.     count_words($docid_count, $docid_base, \$content, $kanji);
  486.     make_phrase_hash($docid_count, $docid_base, \$content);
  487.  
  488.     # assertion
  489.     util::assert($cfile_size != 0, 
  490.          "cfile_size == 0 at the end of namazu_core.");
  491.  
  492.     return $cfile_size;
  493. }
  494.  
  495. #
  496. # Make the URI from the given file name.
  497. #
  498. sub generate_uri (@) {
  499.     my ($file, $fragment) = @_;
  500.     return "" unless defined $file;
  501.  
  502.     # omit a file name if omittable
  503.     $file =~ s!^(.*)/($conf::DIRECTORY_INDEX)$!$1/!o; 
  504.  
  505.     if (defined $ReplaceCode) {
  506.     # transforming URI by evaling
  507.     $_ = $file;
  508.     eval $ReplaceCode;
  509.     $file = $_;
  510.     }
  511.  
  512.     if (($SYSTEM eq "MSWin32") || ($SYSTEM eq "os2")) {
  513.     $file =~ s#^([A-Z]):#/$1|#i; # converting a drive part like: /C|
  514.     }
  515.  
  516.     if (($SYSTEM eq "MSWin32") || ($SYSTEM eq "os2")) {
  517.     $file = codeconv::shiftjis_to_eucjp($file);
  518.     }
  519.     if (defined $fragment) {
  520.         codeconv::toeuc(\$fragment);
  521.     }
  522.  
  523.     unless ($var::Opt{'noencodeuri'}) {
  524.     for my $tmp ($file, $fragment) {
  525.         next unless defined $tmp;
  526.  
  527.         # Escape unsafe characters (not strict)
  528.         $tmp =~ s/\%/%25/g;  # Convert original '%' into '%25' v1.1.1.2
  529.         $tmp =~ s/([^a-zA-Z0-9~\-\_\.\/\:\%])/
  530.         sprintf("%%%02X",ord($1))/ge;
  531.     }
  532.     }
  533.  
  534.  
  535.     my $uri = $file;
  536.     $uri .= "#" . $fragment if defined $fragment;
  537.     if (($SYSTEM eq "MSWin32") || ($SYSTEM eq "os2")) {
  538.         # restore '|' for drive letter rule of Win32, OS/2
  539.         $uri =~ s!^/([A-Z])%7C!/$1|!i;
  540.     }
  541.     return $uri;
  542. }
  543.  
  544.  
  545. sub get_field_index_base (\%) {
  546.     my ($field_indices) = @_;
  547.  
  548.     my @keys = split('\|', $conf::SEARCH_FIELD);
  549.     if ($var::Opt{'meta'}) {
  550.     push @keys, (split '\|', $conf::META_TAGS);
  551.     }
  552.     for my $key (@keys) {
  553.     $key = lc($key);
  554.     my $fname    = "$var::NMZ{'field'}.$key";
  555.     my $tmp_fname = util::tmpnam("NMZ.field.$key");
  556.     my $size = 0;
  557.     $size = -s $fname if -f $fname;
  558.     $size += -s $tmp_fname if -f $tmp_fname;
  559.     $field_indices->{$key} = $size;
  560.     }
  561. }
  562.  
  563. sub complete_field_info (\%$$\$\$\$) {
  564.     my ($fields, $cfile, $uri, $headings, $contref, $wsref) = @_;
  565.  
  566.     unless (defined($fields->{'title'})) {
  567.     $fields->{'title'} = gfilter::filename_to_title($cfile, $wsref);
  568.     }
  569.     unless (defined($fields->{'date'})) {
  570.     my $mtime = (stat($cfile))[9];
  571.     my $date = util::rfc822time($mtime);
  572.     $fields->{'date'} = $date;
  573.     }
  574.     unless (defined($fields->{'uri'})) {
  575.     $fields->{'uri'} = $uri;
  576.     }
  577.     unless (defined($fields->{'size'})) {
  578.     $fields->{'size'} = -s $cfile;
  579.     }
  580.     unless (defined($fields->{'summary'})) {
  581.     $fields->{'summary'} = make_summary($contref, $headings, $cfile);
  582.     }
  583.     unless (defined($fields->{'from'}) || defined($fields->{'author'})) {
  584.     $fields->{'from'} = getmsg("unknown");
  585.     }
  586. }
  587.  
  588. #
  589. # Currently, messages for NMZ.* files should be encoded in
  590. # EUC-JP currently. We cannot use gettext.pl for the messsage
  591. # because gettext.pl may use Shift_JIS encoded messages.
  592. # So, we should use the function instead of gettext().
  593. #
  594. # FIXME: Ad hoc impl.  getmsg() is effective only for "unknown".
  595. #
  596. sub getmsg($) {
  597.     my ($msg) = @_;
  598.  
  599.     if (util::islang_msg("ja")) {
  600.     if ($msg eq "unknown") {
  601.         return "╔╘╠└";
  602.     }
  603.     }
  604.     return $msg;
  605. }
  606.  
  607. sub make_summary ($$$) {
  608.     my ($contref, $headings, $cfile) = @_;
  609.  
  610.     # pick up $conf::MAX_FIELD_LENGTH bytes string
  611.     my $tmp = "";
  612.     if ($$headings ne "") {
  613.     $$headings =~ s/^\s+//;
  614.     $$headings =~ s/\s+/ /g;
  615.     $tmp = $$headings;
  616.     } else {
  617.     $tmp = "";
  618.     }
  619.  
  620.     my $offset = 0;
  621.     my $tmplen = 0;
  622.     while (($tmplen = $conf::MAX_FIELD_LENGTH + 1 - length($tmp)) > 0
  623.            && $offset < length($$contref))
  624.     {
  625.         $tmp .= substr $$contref, $offset, $tmplen;
  626.         $offset += $tmplen;
  627.         $tmp =~ s/(([\xa1-\xfe]).)/$2 eq "\xa8" ? '': $1/ge;
  628.         $tmp =~ s/([-=*\#])\1{2,}/$1$1/g;
  629.     }
  630.  
  631.     # -1 means "LF"
  632.     my $summary = substr $tmp, 0, $conf::MAX_FIELD_LENGTH - 1;
  633.     # Remove a garbage Kanji 1st char at the end.
  634.     $summary = codeconv::chomp_eucjp($summary);
  635.  
  636.     $summary =~ s/^\s+//;
  637.     $summary =~ s/\s+/ /g;   # normalize white spaces
  638.  
  639.     return $summary;
  640. }
  641.  
  642.  
  643. # output the field infomation into NMZ.fields.* files
  644. sub put_field_index (\%$) {
  645.     my ($fields, $field_indices) = @_;
  646.  
  647.     my $aliases_regex = 
  648.     join('|', sort {length($b) <=> length($a)} keys %conf::FIELD_ALIASES);
  649.  
  650.     for my $field (keys %{$fields}) {
  651.         util::dprint("Field: $field: $fields->{$field}\n");
  652.     if ($field =~ /^($aliases_regex)$/o) {
  653.         unless (defined($fields->{$conf::FIELD_ALIASES{$field}})) {
  654.         $fields->{$conf::FIELD_ALIASES{$field}} = $fields->{$field};
  655.         }
  656.         undef $fields->{$field};
  657.     }
  658.     }
  659.  
  660.     my @keys = split '\|', $conf::SEARCH_FIELD;
  661.     if ($var::Opt{'meta'}) {
  662.     push @keys, (split '\|', $conf::META_TAGS);
  663.  
  664.         # uniq @keys
  665.         my %mark = ();
  666.         @keys = grep {$mark{$_}++; $mark{$_} == 1} @keys;
  667.     }
  668.     for my $key (@keys) {
  669.     my $lkey = lc($key);
  670.     my $fname    = util::tmpnam("NMZ.field.$lkey");
  671.     my $fh_field = util::efopen(">>$fname");
  672.     my $output = "";
  673.     if (defined($fields->{$key})) {
  674.         if ($key ne 'uri') { # workaround for namazu-bugs-ja#30
  675.         $fields->{$key} =~ s/\s+/ /g;
  676.         $fields->{$key} =~ s/\s+$//;
  677.         $fields->{$key} =~ s/^\s+//;
  678.         }
  679.         $output = $fields->{$key};
  680.  
  681.         # -1 means "LF"
  682.         $output = substr $output, 0, $conf::MAX_FIELD_LENGTH - 1;
  683.         # Remove a garbage Kanji 1st char at the end.
  684.         $output = codeconv::chomp_eucjp($output);
  685.  
  686.         $output .= "\n";
  687.     } else {
  688.         $output = "\n";
  689.     }
  690.     print $fh_field $output;
  691.  
  692.     # put index of field index
  693.     {
  694.         my $fname        = util::tmpnam("NMZ.field.$lkey.i");
  695.         my $fh_field_idx = util::efopen(">>$fname");
  696.         print $fh_field_idx pack("N", $field_indices->{$lkey});
  697.         $field_indices->{$lkey} += length $output;
  698.     }
  699.     }
  700.  
  701. }
  702.  
  703. # put the date infomation into NMZ.t file
  704. sub put_dateindex ($) {
  705.     my ($cfile) = @_;
  706.     my $mtime = (stat($cfile))[9];
  707.  
  708.     my $fh_dataindex = util::efopen(">>$var::NMZ{'_t'}");
  709.     print $fh_dataindex pack("N", $mtime);
  710. }
  711.  
  712.  
  713. # load a document file
  714. sub load_document ($$$$\%) {
  715.     my ($orig_cfile, $contref, $weighted_str, $headings, $fields)
  716.       = @_;
  717.     my $cfile = $$orig_cfile;
  718.  
  719.     return (0, 0, 0, 0) unless (-f $cfile && -r $cfile);
  720.  
  721.     # for handling a filename which contains Shift_JIS code
  722.     my $shelter_cfile = "";
  723.     if ($SYSTEM eq "MSWin32" 
  724.     && $cfile =~ /[\x81-\x9f\xe0-\xef][\x40-\x7e\x80-\xfc]|[\x20\xa1-\xdf]/) 
  725.     {
  726.     $shelter_cfile = $cfile;
  727.     $cfile = util::tmpnam("NMZ.win32");
  728.         copy($shelter_cfile, $cfile);
  729.     }
  730.  
  731.     my $file_size;
  732.     $file_size = util::filesize($cfile); # not only file in feature.
  733.     if ($file_size > $conf::FILE_SIZE_MAX) {
  734.     return ($file_size, $file_size, 0, 'x-system/x-error');
  735.     }
  736.  
  737.     $$contref = util::readfile($cfile);
  738. #    $file_size = length($$contref);
  739.  
  740.     # Filtering process.
  741.     my $mtype;
  742.     my $called_dt = 0;
  743.     while (1) {
  744.     if (defined $MediaType) {
  745.         $mtype = $MediaType;
  746.     } else {
  747.         my $mtype_n;
  748.         if ($shelter_cfile ne "") {
  749.         $mtype_n = $Magic->checktype_byfilename($shelter_cfile);
  750.         } else {
  751.         $mtype_n = $Magic->checktype_byfilename($cfile);
  752.         }
  753.         my $mtype_c = $Magic->checktype_data($$contref);
  754.         my $mtype_m;
  755.         $mtype_m = $Magic->checktype_magic($$contref) 
  756.           if ((! defined $mtype_c) ||
  757.           $mtype_c =~ 
  758.           /^(text\/html|text\/plain|application\/octet-stream)$/);
  759.         $mtype_c = $mtype_m 
  760.         if (defined $mtype_m && 
  761.             $mtype_m !~ 
  762.             /^(text\/html|text\/plain|application\/octet-stream)$/);
  763.         $mtype_c = 'text/plain' unless defined $mtype_c;
  764.         if ($called_dt) {
  765.         $mtype = $mtype_c;
  766.         } else {
  767.         $mtype = decide_type($mtype_n, $mtype_c);
  768.         $called_dt = 1;
  769.         }
  770.     }
  771.     util::dprint(_("Detected type: ")."$mtype\n");
  772.  
  773.     # Pre code conversion.
  774.     if ($var::REQUIRE_PRE_CODECONV{$mtype}) {
  775.         util::dprint("pre_codeconv\n");
  776.         codeconv_document($contref);
  777.     }
  778.  
  779.     if (! $var::Supported{$mtype} || 
  780.         $var::Supported{$mtype} ne 'yes') 
  781.     {
  782.         util::vprint(_("Unsupported media type ")."$mtype\n");
  783.         return ($file_size, $file_size, 0, "$mtype; x-system=unsupported");
  784.     }
  785.  
  786.     if ($var::REQUIRE_ACTIONS{$mtype}) {
  787.         util::vprint(_("Using ")."$var::REQUIRE_ACTIONS{$mtype}.pl\n");
  788.         require $var::REQUIRE_ACTIONS{$mtype}.'.pl'
  789.             || die _("unable to require ") . 
  790.             "\"$var::REQUIRE_ACTIONS{$mtype}.pl\"\n";
  791.         my $err = undef;
  792.         eval '$err = ' . $var::REQUIRE_ACTIONS{$mtype} .
  793.           '::filter($orig_cfile, $contref, $weighted_str, $headings, $fields);';
  794.         if ($err) {
  795.         return ($file_size, $file_size, 0, "$mtype; x-error=$err");
  796.         }
  797.  
  798.         if ($@) {
  799.         util::vprint(_("Failed to call ")."$var::REQUIRE_ACTIONS{$mtype}\n$@\n");
  800.         return ($file_size, $file_size, 0, "$mtype; x-error=$@");
  801.         }
  802.  
  803.         # Post code conversion.
  804.         if ($var::REQUIRE_POST_CODECONV{$mtype}) {
  805.             util::dprint("post_codeconv\n");
  806.         codeconv_document($contref);
  807.         }
  808.  
  809.         next if ($var::RECURSIVE_ACTIONS{$mtype});
  810.     }
  811.     last;
  812.     }
  813.  
  814.     # Measure the text size at this time.
  815.     my $text_size = length($$contref) + length($$weighted_str); 
  816.  
  817.     if ($SYSTEM eq "MSWin32" && $shelter_cfile ne "") {
  818.     unlink $cfile;
  819.     $cfile = $shelter_cfile;
  820.     }
  821.  
  822.     my $kanji = $$contref =~ tr/\xa1-\xfe/\xa1-\xfe/;  # Kanji contained?
  823.     $kanji += $$weighted_str =~ tr/\xa1-\xfe/\xa1-\xfe/;
  824.  
  825.     return ($file_size, $text_size, $kanji, $mtype);
  826. }
  827.  
  828. sub codeconv_document ($) {
  829.     my ($textref) = @_;
  830.     codeconv::toeuc($textref);
  831.     $$textref =~ s/\r\n/\n/g;
  832.     $$textref =~ s/\r/\n/g;
  833. }
  834.  
  835. sub prep () {
  836.     my $docid_base = 0;
  837.     my $output_dir = shift @_ ;
  838.     my @targets = @_ ;
  839.     my @flist = ();
  840.  
  841.     $var::OUTPUT_DIR = $output_dir;
  842.  
  843.     require_modules();
  844.     change_filenames();
  845.     check_present_index();
  846.  
  847.     # if Checkpoint mode, return
  848.     return (0, 0) if $CheckPoint{'continue'};
  849.  
  850.     check_lockfile($var::NMZ{'lock2'});
  851.     print _("Looking for indexing files...\n");
  852.     @flist = find_target(@targets);
  853.     ($docid_base, @flist) = append_index(@flist) 
  854.     if -f $var::NMZ{'r'};
  855.     unless (@flist) { # if @flist is empty
  856.     print _("No files to index.\n");
  857.     exit 0;
  858.     }
  859.     set_lockfile($var::NMZ{'lock2'});
  860.     save_flist(@flist);
  861.     my $total_files_num = @flist;
  862.  
  863.     return ($docid_base, $total_files_num);
  864. }
  865.  
  866. sub save_flist(@) {
  867.     my @flist = @_;
  868.     return if (@flist == 0);
  869.  
  870.     my $fh_flist = util::efopen(">$var::NMZ{'_flist'}");
  871.     print $fh_flist join("\n", @flist), "\n";
  872. }
  873.  
  874. sub require_modules() {
  875.     if (util::islang("ja") && $conf::NKF =~ /^module_nkf/) {
  876.     require NKF || die "unable to require \"NKF\"\n";
  877.         util::dprint(_("code conversion: using NKF module\n"));
  878.     $var::USE_NKF_MODULE = 1;
  879.     }
  880.     if (util::islang("ja") && $conf::WAKATI =~ /^module_kakasi/) {
  881.     require Text::Kakasi || die "unable to require \"Text::Kakasi\"\n";
  882.         util::dprint(_("wakati: using Text::Kakasi module\n"));
  883.     my $res = Text::Kakasi::getopt_argv('kakasi', '-ieuc', '-oeuc', '-w');
  884.     }
  885.     if (util::islang("ja") && $conf::WAKATI =~ /^module_chasen/) {
  886.     require Text::ChaSen || die "unable to require \"Text::ChaSen\"\n";
  887.         util::dprint(_("wakati: using Text::ChaSen module\n"));
  888.     my @arg = ('-j', '-F', '%m ');
  889.     @arg    = ('-j', '-F', '%m %H\\n') if $var::Opt{'noun'};
  890.     my $res = Text::ChaSen::getopt_argv('chasen-perl', @arg);
  891.     }
  892. }
  893.  
  894. sub check_lockfile ($) {
  895.     # warn if check file exists in case other process is running or abnormal
  896.     # stop execution (later is not the major purpose, though).
  897.     # This is mainly for early detection before longish find_target.
  898.     my ($file) = @_;
  899.  
  900.     if (-f $file) {
  901.     print "$file "._("found. Maybe this index is being updated by another process now.\nIf not, you can remove this file.\n");
  902.     exit 1;
  903.     }
  904. }
  905.  
  906. sub set_lockfile ($) {
  907.     my ($file) = @_;
  908.  
  909.     # make a lock file
  910.     if (-f $file) {
  911.     print "$file found. Maybe this index is being updated by another process now.\nIf not, you can remove this file.\n";
  912.     exit 1;
  913.     } else {
  914.     my $fh_lockfile = util::efopen(">$file");
  915.     print $fh_lockfile "$$"; # save pid
  916.     }
  917. }
  918.  
  919. sub remove_lockfile ($) {
  920.     my ($file) = @_;
  921.  
  922.     # remove lock file
  923.     unlink $file if -f $file;
  924. }
  925.  
  926. # check present index whether it is old type of not
  927. sub check_present_index () {
  928.     if (-f $var::NMZ{'i'} && ! -f "$var::NMZ{'result'}.normal") 
  929.     {
  930.     util::cdie(_("Present index is old type. it's unsupported.\n"));
  931.     }
  932. }
  933.  
  934. # remain
  935. sub do_remain_job ($$$$) {
  936.     my ($total_files_size, $docid_count, $key_count, $start_time) = @_;
  937.  
  938.     if ($docid_count == 0) {
  939.     # No files are indexed
  940.     if ($DeletedFilesCount > 0) {
  941.         update_dateindex();
  942.         update_registry($docid_count);
  943.     }
  944.     } else {
  945.     set_lockfile($var::NMZ{'lock'});
  946.     write_version();
  947.     write_body_msg();
  948.     write_tips_msg();
  949.     write_result_file();
  950.     update_field_index();
  951.     update_dateindex();
  952.     update_registry($docid_count);
  953.     write_nmz_files();
  954.     make_slog_file();
  955.     remove_lockfile($var::NMZ{'lock'});
  956.     }
  957.     make_headfoot_pages($docid_count, $key_count);
  958.     put_log($total_files_size, $start_time, $docid_count, $key_count);
  959.     util::remove_tmpfiles();
  960.     unlink $var::NMZ{'_flist'};
  961. }
  962.  
  963. sub make_headfoot_pages($$) {
  964.     my ($docid_count, $key_count) = @_;
  965.  
  966.     for my $file (glob "$TEMPLATEDIR/NMZ.head*") {
  967.     $file =~ m!.*/NMZ.head(.*)$!;
  968.     my $suffix = $1;
  969.     make_headfoot("$var::NMZ{'head'}${suffix}", $docid_count, $key_count);
  970.     }
  971.     for my $file (glob "$TEMPLATEDIR/NMZ.foot*") {
  972.     $file =~ m!.*/NMZ.foot(.*)$!;
  973.     my $suffix = $1;
  974.     make_headfoot("$var::NMZ{'foot'}${suffix}", $docid_count, $key_count);
  975.     }
  976. }
  977.  
  978. # Parse command line options.
  979. sub parse_options
  980. {
  981.     if (@ARGV == 0) {
  982.     show_mini_usage();
  983.     exit 1;
  984.     }
  985.  
  986.     my @targets = ();
  987.     my $targets_loaded = 0;
  988.     my @argv = @ARGV;
  989.     my $cwd = cwd();
  990.  
  991.     my $opt_dummy = 0;
  992.     my $opt_version = 0;
  993.     my $opt_help = 0;
  994.     my $opt_all = 0;
  995.     my $opt_chasen = 0;
  996.     my $opt_chasen_noun = 0;
  997.     my $opt_kakasi = 0;
  998.     my $opt_checkpoint_sub = 0;
  999.     my $opt_show_config = 0;
  1000.     my $opt_mailnews = 0;
  1001.     my $opt_mhonarc = 0;
  1002.  
  1003.     my $opt_quiet = undef;
  1004.     my $opt_config = undef;
  1005.     my $output_dir = undef;
  1006.     my $update_index = undef;
  1007.     my $include_file = undef;
  1008.     my $target_list = undef;
  1009.     my $index_lang = undef;
  1010.  
  1011. #    Getopt::Long::Configure('bundling');
  1012.     Getopt::Long::config('bundling');
  1013.     GetOptions(
  1014.                   '0|help'              => \$opt_help,
  1015.            '1|exclude=s'         => \$conf::EXCLUDE_PATH,
  1016.            '2|deny=s'            => \$conf::DENY_FILE,
  1017.            '3|allow=s'           => \$conf::ALLOW_FILE,
  1018.            '4|update=s'          => \$update_index,
  1019.            '5|mhonarc'           => \$opt_mhonarc,
  1020.            '6|mtime=s'           => \$var::Opt{'mtime'},
  1021.            '7|html-split'        => \$var::Opt{'htmlsplit'},
  1022.            'C|show-config'       => \$opt_show_config,
  1023.            'E|no-edge-symbol'    => \$var::Opt{'noedgesymbol'},
  1024.            'F|target-list=s'     => \$target_list,
  1025.            'G|no-okurigana'      => \$var::Opt{'okurigana'},
  1026.            'H|no-hiragana'       => \$var::Opt{'hiragana'},
  1027.            'I|include=s'         => \$include_file,
  1028.            'K|no-symbol'         => \$var::Opt{'nosymbol'},
  1029.            'L|indexing-lang=s'     => \$index_lang,
  1030.            'M|meta'              => \$var::Opt{'meta'},
  1031.            'O|output-dir=s'      => \$output_dir,
  1032.            'S|checkpoint-sub'    => \$opt_checkpoint_sub,
  1033.            'T|template-dir=s'    => \$TEMPLATEDIR,
  1034.            'U|no-encode-uri'     => \$var::Opt{'noencodeuri'} ,
  1035.            'V|verbose'           => \$var::Opt{'verbose'},
  1036.            'Y|no-delete'         => \$var::Opt{'nodelete'},
  1037.            'Z|no-update'         => \$var::Opt{'noupdate'},
  1038.            'a|all'               => \$opt_all,
  1039.            'c|use-chasen'        => \$opt_chasen,
  1040.            'd|debug'             => \$var::Opt{'debug'},
  1041.            'e|robots'            => \$var::Opt{'robotexclude'},
  1042.            'f|config=s'          => \$opt_config,
  1043.            'h|mailnews'          => \$opt_mailnews,
  1044.            'k|use-kakasi'        => \$opt_kakasi,
  1045.            'm|use-chasen-noun'   => \$opt_chasen_noun,
  1046.            'q|quiet'             => \$opt_quiet,
  1047.            'r|replace=s'         => \$ReplaceCode,
  1048.            's|checkpoint'        => \$CheckPoint{'on'},
  1049.            't|media-type=s'      => \$MediaType,
  1050.            'u|uuencode'          => \$opt_dummy, # for backward compat.
  1051.            'v|version'           => \$opt_version,
  1052.            'x|no-heading-summary'=> \$var::Opt{'noheadabst'},
  1053.            );
  1054.  
  1055.     if ($opt_quiet) {
  1056.     # Make STDOUT quiet by redirecting STDOUT to null device.
  1057.     my $devnull = util::devnull();
  1058.     open(STDOUT, ">$devnull") || die "$devnull: $!";
  1059.     }
  1060.  
  1061.     if ($opt_config) {
  1062.     load_rcfile($ConfigFile = $opt_config);
  1063.     }
  1064.     load_filtermodules(); # to make effect $opt_config.
  1065.     postload_modules();
  1066.  
  1067.     if ($index_lang) {
  1068.     $util::LANG = $index_lang;
  1069.       util::dprint("Override indexing language: $util::LANG\n");
  1070.     }
  1071.  
  1072.     if ($opt_help) {
  1073.     show_usage();
  1074.     exit 1;
  1075.     }
  1076.  
  1077.     if ($opt_version) {
  1078.     show_version();
  1079.     exit 1;
  1080.     }
  1081.  
  1082.     if ($opt_show_config) {
  1083.     show_config();
  1084.     exit 1;
  1085.     }
  1086.  
  1087.     if (defined $update_index) {
  1088.     unless (-d $update_index) {
  1089.         print _("No such index: "), "$update_index\n";
  1090.         exit 1;
  1091.     }
  1092.  
  1093.     my $orig_status = $var::NMZ{'status'};
  1094.     $var::NMZ{'status'} = "$update_index/$var::NMZ{'status'}";
  1095.  
  1096.     my $argv = get_status("argv");
  1097.     @ARGV = split /\t/, $argv;
  1098.     util::dprint(_("Inherited argv: ")."@ARGV\n");
  1099.  
  1100.     my $cwd  = get_status("cwd");
  1101.     chdir $cwd;
  1102.     util::dprint(_("Inherited cwd: ")."$cwd\n");
  1103.  
  1104.     ($output_dir, @targets) = parse_options();
  1105.     $output_dir = $update_index;
  1106.     $var::NMZ{'status'} = $orig_status;  # See also change_filenames()
  1107.     return ($output_dir, @targets);
  1108.     }
  1109.  
  1110.     if ($opt_mailnews) {
  1111.     $MediaType = 'message/rfc822';
  1112.     }
  1113.     if ($opt_mhonarc) {
  1114.     $MediaType = 'text/html; x-type=mhonarc';
  1115.     }
  1116.     if ($opt_all) {
  1117.     $conf::ALLOW_FILE = ".*";
  1118.     }
  1119.     if ($opt_chasen) {
  1120.     $conf::WAKATI = $conf::CHASEN;
  1121.     $var::Opt{'noun'} = 0;
  1122.     }
  1123.     if ($opt_chasen_noun) {
  1124.     $conf::WAKATI = $conf::CHASEN_NOUN;
  1125.     $var::Opt{'noun'} = 1;
  1126.     }
  1127.     if ($opt_kakasi) {
  1128.     $conf::WAKATI = $conf::KAKASI;
  1129.     $var::Opt{'noun'} = 0;
  1130.     }
  1131.     if ($include_file) {
  1132.     do $include_file;
  1133.         util::dprint("Included: $include_file\n");
  1134.     }
  1135.     if ($target_list) {
  1136.     if ($CheckPoint{'continue'}) {
  1137.         @targets = ("dummy");
  1138.     } else {
  1139.         @targets = load_target_list($target_list);
  1140.         util::dprint(_("Loaded: ")."$target_list\n");
  1141.     }
  1142.     $targets_loaded = 1;
  1143.     }
  1144.     if ($opt_checkpoint_sub) {
  1145.     $CheckPoint{'on'}           = 1;
  1146.     $CheckPoint{'continue'}     = 1;
  1147.     @argv = grep {! /^-S$/} @argv;  # remove -S
  1148.     }
  1149.  
  1150.     if (defined $ReplaceCode) {
  1151.     my $orig = "/foo/bar/baz/quux.html";
  1152.     $_ = $orig;
  1153.     eval $ReplaceCode;
  1154.     if ($@) {  # eval error
  1155.         util::cdie(_("Invalid replace: ")."$ReplaceCode\n");
  1156.     }
  1157.     util::dprint(_("Replace: ")."$orig -> $_\n");
  1158.     }
  1159.  
  1160.     if (@ARGV == 0 && $targets_loaded == 0) {
  1161.     show_mini_usage();
  1162.     exit 1;
  1163.     }
  1164.  
  1165.     $output_dir = $cwd unless defined $output_dir;
  1166.     util::cdie("$output_dir: "._("invalid output directory\n"))
  1167.     unless (-d $output_dir && -w $output_dir);
  1168.  
  1169.     if ($SYSTEM eq "MSWin32" || $SYSTEM eq "os2") {
  1170.     # convert \ to / with consideration for Shift_JIS Kanji code
  1171.     $output_dir =~ 
  1172.         s!([\x81-\x9f\xe0-\xef][\x40-\x7e\x80-\xfc]|[\x01-\x7f])!
  1173.         $1 eq "\\" ? "/" : $1!gex;
  1174.     }
  1175.  
  1176.     # take remaining @ARGV as targets
  1177.     if (@ARGV > 0 && $targets_loaded == 0) {
  1178.     @targets = @ARGV ;
  1179.     }
  1180.     
  1181.     # revert @ARGV
  1182.     # unshift @ARGV, splice(@argv, 0, @argv - @ARGV);
  1183.     @ARGV = @argv;
  1184.  
  1185.     return ($output_dir, @targets);
  1186. }
  1187.  
  1188. sub show_config () {
  1189.     print _("Loaded rcfile: ") . "@LoadedRcfiles\n" if @LoadedRcfiles;
  1190.     print _("System: ") . "$SYSTEM\n" if $SYSTEM;
  1191.     print _("Namazu: ") . "$var::VERSION\n" if $var::VERSION;
  1192.     print _("Perl: ") . "$]\n" if $];   # '$]' has a perl version
  1193.     print _("NKF: ") . "$conf::NKF\n" if $conf::NKF;
  1194.     print _("KAKASI: ") . "$conf::KAKASI\n" if $conf::KAKASI;
  1195.     print _("ChaSen: ") . "$conf::CHASEN\n" if $conf::CHASEN;
  1196.     print _("Wakati: ") . "$conf::WAKATI\n" if $conf::WAKATI;
  1197.     print _("Lang_Msg: ") . "$util::LANG_MSG\n";
  1198.     print _("Lang: ") . "$util::LANG\n";
  1199.     print _("Coding System: ") . "$CodingSystem\n";
  1200.     print _("CONFDIR: ") . "$CONFDIR\n";
  1201.     print _("LIBDIR: ") . "$LIBDIR\n";
  1202.     print _("FILTERDIR: ") . "$FILTERDIR\n";
  1203.     print _("TEMPLATEDIR: ") . "$TEMPLATEDIR\n";
  1204.  
  1205.     my @supported = sort grep { $var::Supported{$_} eq "yes" }
  1206.     keys %var::Supported;
  1207.     print _("Supported media types: \n");
  1208.     for my $mtype (@supported) {
  1209.     print "  $mtype\n";
  1210.     }
  1211. }
  1212.  
  1213. sub load_target_list ($) {
  1214.     my ($file) = @_;
  1215.     my $fh_targets = util::efopen($file);
  1216.     my @targets = <$fh_targets>;
  1217.     if (($SYSTEM eq "MSWin32") || ($SYSTEM eq "os2")) {
  1218.     grep { 
  1219.         s/\r//g; 
  1220.         # Replace \ with / with consideration for Shift_JIS.
  1221.         s!([\x81-\x9f\xe0-\xef][\x40-\x7e\x80-\xfc]|[\x01-\x7f])!
  1222.         $1 eq "\\" ? "/" : $1!gex;
  1223.     } @targets;
  1224.     }
  1225.     chomp @targets; 
  1226.     return @targets;
  1227. }
  1228.  
  1229. # convert a relative path into an absolute path
  1230. sub absolute_path($$) {
  1231.     my ($cwd, $path) = @_;
  1232.  
  1233.     $path =~ s!^\.$!\./!;
  1234.     $path =~ s!^\.[/\\]!$cwd/!;
  1235.     if (($SYSTEM eq "MSWin32") || ($SYSTEM eq "os2")) {
  1236.         $path =~ s!([\x81-\x9f\xe0-\xef][\x40-\x7e\x80-\xfc]|[\x01-\x7f])!
  1237.         $1 eq "\\" ? "/" : $1!gex;
  1238.         $path =~ s,^([A-Z](?!:/)),$cwd/$1,i;
  1239.     } else {
  1240.         $path =~ s!^([^/])!$cwd/$1!; 
  1241.     }
  1242.     return $path;
  1243. }
  1244.  
  1245. sub find_target (@) {
  1246.     my @targets = @_;
  1247.  
  1248.     my $cwd = cwd();
  1249.     @targets = map { absolute_path($cwd, $_) } @targets;
  1250.  
  1251.     # Convert \ to / with consideration for Shift_JIS encoding.
  1252.     if (($SYSTEM eq "MSWin32") || ($SYSTEM eq "os2")) {
  1253.     grep {
  1254.         $_ =~ s!([\x81-\x9f\xe0-\xef][\x40-\x7e\x80-\xfc]|[\x01-\x7f])!
  1255.         $1 eq "\\" ? "/" : $1!gex;
  1256.     } @targets;
  1257.     }
  1258.  
  1259.     # For reporting effects of --allow, --deny, --exclude, --mtime
  1260.     # options in --verbose mode.
  1261.     my %counts = (); 
  1262.     $counts{'possible'} = 0;
  1263.     $counts{'excluded'} = 0;
  1264.     $counts{'too_old'} = 0;
  1265.     $counts{'too_new'} = 0;
  1266.     $counts{'not_allowed'} = 0;
  1267.     $counts{'denied'} = 0;
  1268.  
  1269.     # Traverse directories.
  1270.     # This routine is not efficent but I prefer reliable logic.
  1271.     my @flist = ();
  1272.     my $start = time();
  1273.     util::vprint(_("find_target starting: "). localtime($start). "\n");
  1274.     while (@targets) {
  1275.     my $target = shift @targets;
  1276.  
  1277.     if ($target eq '') {
  1278.         print STDERR "Warning: target contains empty line, skip it\n";
  1279.         next;
  1280.     }
  1281.     
  1282.     if (-f $target) { # target is a file.
  1283.         add_target($target, \@flist, \%counts);
  1284.     } elsif (-d $target) { # target is a directory.
  1285.         my @subtargets = ();
  1286.         # Find subdirectories in target directory
  1287.         # because File::Find::find() does not follow symlink.
  1288.         if (-l $target) {
  1289.         my $dh = new DirHandle($target);
  1290.         while (defined(my $ent = $dh->read)) {
  1291.             next if ($ent =~ /^\.{1,2}$/);
  1292.             my $fname = "$target/$ent";
  1293.             next if ($fname eq '.' || $fname eq '..');
  1294.             if (-d $fname) {
  1295.             push(@subtargets, $fname);
  1296.             } else {
  1297.             add_target($fname, \@flist, \%counts);
  1298.             }
  1299.         }
  1300.         } else {
  1301.         @subtargets = ($target);
  1302.         }
  1303.  
  1304.         #
  1305.         # Wanted routine for File::Find's find().
  1306.         #
  1307.         my $wanted_closure = sub {
  1308.         my $fname = "$File::Find::dir/$_";
  1309.         add_target($fname, \@flist, \%counts);
  1310.         };
  1311.  
  1312.         find($wanted_closure, @subtargets) if (@subtargets > 0);
  1313.     } else {
  1314.         print STDERR _("unsupported target: ") . $target;
  1315.     }
  1316.     }
  1317.  
  1318.     # uniq @flist
  1319.     my %mark = ();
  1320.     @flist = grep {$mark{$_}++; $mark{$_} == 1} @flist;
  1321.  
  1322.     # Sort file names with consideration for numbers.
  1323.     @flist = map  { $_->[0] }
  1324.          sort { $a->[1] cmp $b->[1] } 
  1325.          map  { my $tmp = $_; $tmp =~ s/(\d+)/sprintf("%08d", $1)/ge; 
  1326.             [ $_, $tmp ] } @flist;
  1327.  
  1328.     my $elapsed = time() - $start ;
  1329.     $elapsed += 1 ;   # to round up and avoid 0 
  1330.  
  1331.     # For --verbose option.
  1332.     report_find_target($elapsed, $#flist + 1, %counts);
  1333.  
  1334.     return @flist;
  1335. }
  1336.  
  1337. sub add_target ($\@\%) {
  1338.     my ($target, $flists_ref, $counts_ref) = @_;
  1339.  
  1340.     if ($target =~ /[\n\r\t]/) {
  1341.     $target =~ s/[\n\r\t]//g;
  1342.     print STDERR "Warning: $target contains LF/CR/TAB chars, skip it\n";
  1343.     return;   # skip a file name containing LF/CR/TAB chars.
  1344.     }
  1345.  
  1346.     return unless -f $target;  # Only file is targeted.
  1347.  
  1348.     $counts_ref->{'possible'}++;
  1349.  
  1350.     unless (-r $target) {
  1351.         util::vprint(sprintf(_("Unreadable:    %s"), $target));
  1352.     $counts_ref->{'excluded'}++;
  1353.     return;
  1354.     }
  1355.  
  1356.  
  1357.     if (defined $conf::EXCLUDE_PATH && 
  1358.     $target =~ /$conf::EXCLUDE_PATH/ ) 
  1359.     {
  1360.         util::vprint(sprintf(_("Excluded:    %s"), $target));
  1361.     $counts_ref->{'excluded'}++;
  1362.     return; 
  1363.     }
  1364.  
  1365.     #
  1366.     # Do processing just like find's  --mtime option.
  1367.     #
  1368.     if (defined $var::Opt{'mtime'}) {
  1369.     my $mtime = -M $_;
  1370.     if ($var::Opt{'mtime'} < 0) {
  1371.  
  1372.         # This must be `>=' not `>' for consistency with find(1).
  1373.         if (int($mtime) >= - $var::Opt{'mtime'}) {
  1374.             util::vprint(sprintf(_("Too old:    %s"), $target));
  1375.             $counts_ref->{'too_old'}++;
  1376.         return;
  1377.         }
  1378.     } elsif ($var::Opt{'mtime'} > 0) {
  1379.         if ($var::Opt{'mtime'} =~ /^\+/) {
  1380.         if ((int($mtime) < $var::Opt{'mtime'})) {
  1381.             util::vprint(sprintf(_("Too new:    %s"), $target));
  1382.             $counts_ref->{'too_new'}++;
  1383.             return;
  1384.         }
  1385.         } else {
  1386.         if (int($mtime) != $var::Opt{'mtime'}) {
  1387.             if (int($mtime) > $var::Opt{'mtime'}) {
  1388.                 util::vprint(sprintf(_("Too old:    %s"),$target));
  1389.             $counts_ref->{'too_old'}++;
  1390.             } else {
  1391.                 util::vprint(sprintf(_("Too new:    %s"),$target));
  1392.             $counts_ref->{'too_new'}++;
  1393.             }
  1394.             return;
  1395.         }
  1396.         }
  1397.     } else {
  1398.         # $var::Opt{'mtime'} == 0 ;
  1399.         return;
  1400.     }
  1401.     }
  1402.  
  1403.     # Extract the file name of the target.
  1404.     $target =~ m!^.*/([^/]+)$!;
  1405.     my $fname = $1;
  1406.  
  1407.     if ($fname =~ m!^($conf::DENY_FILE)$!i ) {
  1408.         util::vprint(sprintf(_("Denied:    %s"), $target));
  1409.     $counts_ref->{'denied'}++; 
  1410.     return;
  1411.     }
  1412.     if ($fname !~ m!^($conf::ALLOW_FILE)$!i) {
  1413.         util::vprint(sprintf(_("Not allowed:    %s"), $target));
  1414.     $counts_ref->{'not_allowed'}++; 
  1415.     return;
  1416.     } else{
  1417.         util::vprint(sprintf(_("Targeted:    %s"), $target));
  1418.     push @$flists_ref, $target;
  1419.     }
  1420.  
  1421. }
  1422.  
  1423. sub report_find_target ($$%) {
  1424.     my ($elapsed, $num_targeted, %counts) = @_;
  1425.  
  1426.     util::vprint(_("find_target finished: ") . localtime(time()). "\n");
  1427.     util::vprint(sprintf(_("Target Files: %d (Scan Performance: Elapsed Sec.: %d, Files/sec: %.1f)"), 
  1428.              $num_targeted, $elapsed, 
  1429.              $num_targeted /$elapsed));
  1430.     util::vprint(sprintf(_("  Possible: %d, Not allowed: %d, Denied: %d, Excluded: %d"), 
  1431.              $counts{'possible'}, 
  1432.              $counts{'not_allowed'},  
  1433.              $counts{'denied'}, 
  1434.              $counts{'excluded'}));
  1435.     util::vprint(sprintf(_("  MTIME too old: %d, MTIME too new: %d"),
  1436.              $counts{'too_old'}, 
  1437.              $counts{'too_new'}));
  1438. }
  1439.  
  1440. sub show_usage () {
  1441.     util::dprint(_("lang_msg: ")."$util::LANG_MSG\n");
  1442.     util::dprint(_("lang: ")."$util::LANG\n");
  1443.  
  1444.     # To know why we should do this, see usage.pl.
  1445.     my $usage = $usage::USAGE;
  1446.     $usage =~ s/\n\n/\n/g; 
  1447.     $usage = _($usage);
  1448.     printf "$usage", $var::VERSION, $var::MAILING_ADDRESS;
  1449. }
  1450.  
  1451. sub show_mini_usage () {
  1452.     print _("Usage: mknmz [options] <target>...\n");
  1453.     print _("Try `mknmz --help' for more information.\n");
  1454. }
  1455.  
  1456. sub show_version () {
  1457.     print $usage::VERSION_INFO;
  1458. }
  1459.  
  1460. #
  1461. # check the file. No $msg is good.
  1462. #
  1463. sub check_file ($$$$$) {
  1464.     my ($cfile, $cfile_size, $text_size, $mtype, $uri) = @_;
  1465.  
  1466.     my $msg = undef;
  1467.     if (! -e $cfile) {
  1468.     $msg = _("does NOT EXIST! skipped.");
  1469.     } elsif (! -r $cfile) {
  1470.     $msg = _("is NOT READABLE! skipped.");
  1471.     } elsif ($text_size == 0 || $cfile_size == 0) {
  1472.     $msg = _("is 0 size! skipped.");
  1473.     } elsif ($mtype =~ /^application\/octet-stream/) {
  1474.     $msg = _("may be a BINARY file! skipped.");
  1475.     } elsif ($text_size > $conf::TEXT_SIZE_MAX) {
  1476.     $msg = _("is too LARGE a text! skipped.");
  1477.     } elsif ($mtype =~ /; x-system=unsupported$/) {
  1478.     $mtype =~ s/; x-system=unsupported$//;
  1479.     $msg = _("Unsupported media type ")."($mtype)"._(" skipped.");
  1480.     } elsif ($mtype =~ /; x-error=.*$/) {
  1481.     $mtype =~ s/^.*; x-error=(.*)$/$1/;
  1482.     $msg = $mtype;
  1483.     } elsif ($mtype =~ /^x-system/) {
  1484.     $msg = _("system error occurred! ")."($mtype)".(" skipped.");
  1485.     } 
  1486.  
  1487.     return $msg;
  1488. }
  1489.  
  1490.  
  1491. #
  1492. # Write NMZ.version file.
  1493. #
  1494. sub write_version() {
  1495.     unless (-f $var::NMZ{'version'}) {
  1496.     my $fh = util::efopen(">$var::NMZ{'version'}");
  1497.     print $fh "Namazu-Index-Version: $NAMAZU_INDEX_VERSION\n";
  1498.     }
  1499. }
  1500.  
  1501. #
  1502. # rename each temporary file to a real file name.
  1503. #
  1504. sub write_nmz_files () {
  1505.     util::Rename($var::NMZ{'_i'},   $var::NMZ{'i'});
  1506.     util::Rename($var::NMZ{'_ii'}, $var::NMZ{'ii'});
  1507.     util::Rename($var::NMZ{'_w'},  $var::NMZ{'w'});
  1508.     util::Rename($var::NMZ{'_wi'}, $var::NMZ{'wi'});
  1509.     util::Rename($var::NMZ{'_p'},  $var::NMZ{'p'});
  1510.     util::Rename($var::NMZ{'_pi'}, $var::NMZ{'pi'});
  1511. }
  1512.  
  1513. # output NMZ.body
  1514. sub write_body_msg () {
  1515.     for my $file (glob "$TEMPLATEDIR/NMZ.body*") {
  1516.     $file =~ m!.*/NMZ.body(.*)$!;
  1517.     my $suffix = $1;
  1518.     write_message("$var::NMZ{'body'}${suffix}");
  1519.     }
  1520. }
  1521.  
  1522. # output NMZ.tips
  1523. sub write_tips_msg () {
  1524.     for my $file (glob "$TEMPLATEDIR/NMZ.tips*") {
  1525.     $file =~ m!.*/NMZ.tips(.*)$!;
  1526.     my $suffix = $1;
  1527.     write_message("$var::NMZ{'tips'}${suffix}");
  1528.     }
  1529. }
  1530.  
  1531.  
  1532. # output NMZ.result.*
  1533. sub write_result_file () {
  1534.     my $fname = "NMZ.result.normal";
  1535.  
  1536.     my @files = glob "$TEMPLATEDIR/NMZ.result.*";
  1537.  
  1538.     for my $file (@files) {
  1539.     $file =~ m!(NMZ\.result\.[^/]*)$!;
  1540.     my $target = "$var::OUTPUT_DIR/$1";
  1541.     if (-f $target) {  # already exist;
  1542.         next;
  1543.     } else {
  1544.         my $buf = util::readfile($file);
  1545.         my $fh_file = util::efopen(">$target");
  1546.         print $fh_file $buf;
  1547.     }
  1548.     }
  1549. }
  1550.  
  1551. # write NMZ.body and etc.
  1552. sub write_message ($) {
  1553.     my ($msgfile) = @_;
  1554.  
  1555.     if (! -f $msgfile) {
  1556.     my ($template, $fname);
  1557.     
  1558.     $msgfile =~ m!.*/(.*)$!;
  1559.     $fname = $1;
  1560.     $template = "$TEMPLATEDIR/$fname";
  1561.  
  1562.     if (-f $template) {
  1563.         my $buf = util::readfile($template);
  1564.         my $fh_output = util::efopen(">$msgfile");
  1565.         print $fh_output $buf;
  1566.     }
  1567.     }
  1568. }
  1569.  
  1570.  
  1571. #
  1572. # Make the NMZ.slog file for logging.
  1573. #
  1574. sub make_slog_file () {
  1575.     {
  1576.     my $fh_slogfile = util::efopen(">>$var::NMZ{'slog'}");
  1577.     }
  1578.     chmod 0666, $var::NMZ{'slog'};
  1579. }
  1580.  
  1581.  
  1582. #
  1583. # Concatenate $CURRENTDIR to the head of each file.
  1584. #
  1585. sub change_filenames ($) {
  1586.     my $dir = $var::OUTPUT_DIR;
  1587.  
  1588.     for my $key (sort keys %var::NMZ) {
  1589.     next if $key =~ /^_/;    # exclude temporary file
  1590.     $var::NMZ{$key} = "$dir/$var::NMZ{$key}";
  1591.     }
  1592.  
  1593.     # temporary files
  1594.     for my $key (sort keys %var::NMZ) {
  1595.     if ($key =~ /^_/) {
  1596.         $var::NMZ{$key} = util::tmpnam($var::NMZ{$key});
  1597.     }
  1598.     }
  1599.  
  1600.     if ($var::Opt{'debug'}) {
  1601.     for my $key (sort keys %var::NMZ) {
  1602.         util::dprint("NMZ: $var::NMZ{$key}\n");
  1603.     }
  1604.     }
  1605. }
  1606.  
  1607.  
  1608. #
  1609. # Preparation processing for appending index files.
  1610. #
  1611. sub append_index (@) {
  1612.     my @flist = @_;
  1613.  
  1614.     my $docid_base = 0;
  1615.     ($docid_base, @flist) = set_target_files(@flist);
  1616.  
  1617.     unless (@flist) {     # if @flist is empty
  1618.     if ($DeletedFilesCount > 0) {
  1619.         make_headfoot_pages(0, 0);
  1620.         set_lockfile($var::NMZ{'lock2'});
  1621.         update_dateindex();
  1622.         update_registry(0);
  1623.         put_log(0, 0, 0, get_total_keys());
  1624.         util::remove_tmpfiles();
  1625.     }
  1626.     print _("No files to index.\n");
  1627.     exit 0;
  1628.     }
  1629.  
  1630.     $APPENDMODE = 1;
  1631.     # conserve files by copying
  1632.     copy($var::NMZ{'i'},  $var::NMZ{'_i'});
  1633.     copy($var::NMZ{'w'},  $var::NMZ{'_w'});
  1634.     copy($var::NMZ{'t'},  $var::NMZ{'_t'}) 
  1635.     unless -f $var::NMZ{'_t'}; # preupdated ?
  1636.     copy($var::NMZ{'p'},  $var::NMZ{'_p'});
  1637.     copy($var::NMZ{'pi'}, $var::NMZ{'_pi'});
  1638.  
  1639.     return ($docid_base, @flist);
  1640. }
  1641.  
  1642. #
  1643. # Set target files to @flist and return with the number of regiested files.
  1644. #
  1645. sub set_target_files() {
  1646.     my %rdocs;    # 'rdocs' means 'registered documents'
  1647.     my @found_files = @_;
  1648.  
  1649.     # Load the list of registered documents
  1650.     $rdocs{'name'} = load_registry();
  1651.  
  1652.     # Pick up overlapped documents and do marking
  1653.     my %mark1;
  1654.     my @overlapped_files;
  1655.     grep {$_ !~ /^\# / && $mark1{$_}++ } @{$rdocs{'name'}};
  1656.     $rdocs{'overlapped'} = {}; # Prepare an anonymous hash.
  1657.     for my $overlapped (grep { $mark1{$_} } @found_files) {
  1658.     $rdocs{'overlapped'}{$overlapped} = 1;
  1659.     push @overlapped_files, $overlapped;
  1660.     };
  1661.  
  1662.     # Pick up not overlapped documents which are files to index.
  1663.     my @flist = grep { ! $mark1{$_} } @found_files;
  1664.      
  1665.     if ($var::Opt{'noupdate'}) {
  1666.     return (scalar @{$rdocs{'name'}}, @flist);
  1667.     };
  1668.  
  1669.     # Load the date index.
  1670.     $rdocs{'mtime'} = load_dateindex();
  1671.  
  1672.     if (@{$rdocs{'mtime'}} == 0) {
  1673.     return (scalar @{$rdocs{'name'}}, @flist); 
  1674.     };
  1675.  
  1676.     util::assert(@{$rdocs{'name'}} == @{$rdocs{'mtime'}},
  1677.          "NMZ.r ($#{$rdocs{'name'}}) and NMZ.t ($#{$rdocs{'mtime'}}) are not consistent!");
  1678.  
  1679.     # Pick up deleted documents and do marking
  1680.     # (registered in the NMZ.r but not existent in the filesystem)
  1681.     my @deleted_documents;
  1682.     unless ($var::Opt{'nodelete'}) {
  1683.     my %mark2;
  1684.     grep { $mark2{$_}++ } @found_files;
  1685.     for my $deleted (grep { $_ !~ /^\# / && ! $mark2{$_} && 
  1686.                 ! $rdocs{'overlapped'}{$_} } 
  1687.              @{$rdocs{'name'}}) 
  1688.     {
  1689.         $rdocs{'deleted'}{$deleted} = 1;
  1690.         push @deleted_documents, $deleted;
  1691.     }
  1692.     }
  1693.  
  1694.     # Pick up updated documents and set the missing number for deleted files.
  1695.     my @updated_documents = pickup_updated_documents(\%rdocs);
  1696.  
  1697.     # Append updated files to the list of files to index.
  1698.     if (@updated_documents) {
  1699.     push @flist, @updated_documents;
  1700.     }
  1701.  
  1702.     # Remove duplicates.
  1703.     my %seen = ();
  1704.     @flist = grep { ! $seen{$_}++ } @flist;
  1705.  
  1706.     util::dprint(_("\n\n== found files ==\n"), join("\n", @found_files), "\n");
  1707.     util::dprint(_("\n\n== registered documents ==\n"), join("\n", @{$rdocs{'name'}}), "\n");
  1708.     util::dprint(_("\n\n== overlapped documents ==\n"), join("\n", @overlapped_files), "\n");
  1709.     util::dprint(_("\n\n== deleted documents ==\n"), join("\n", @deleted_documents), "\n");
  1710.     util::dprint(_("\n\n== updated documents ==\n"), join("\n", @updated_documents), "\n");
  1711.     util::dprint(_("\n\n== files to index ==\n"), join("\n", @flist), "\n");
  1712.  
  1713.     # Update NMZ.t with the missing number infomation and
  1714.     # append updated files and deleted files to NMZ.r with leading '# '
  1715.     if (@updated_documents || @deleted_documents) {
  1716.     $DeletedFilesCount = 0;
  1717.     $UpdatedFilesCount = 0;
  1718.     $UpdatedFilesCount += @updated_documents;
  1719. #    $DeletedFilesCount += @updated_documents;
  1720.     $DeletedFilesCount += @deleted_documents;
  1721.     preupdate_dateindex(@{$rdocs{'mtime'}});
  1722.     preupdate_registry(@updated_documents, @deleted_documents);
  1723.     }
  1724.  
  1725.     # Return the number of registered documents and list of files to index.
  1726.     return (scalar @{$rdocs{'name'}}, @flist);
  1727. }
  1728.  
  1729. sub preupdate_registry(@) {
  1730.     my (@list) = @_;
  1731.  
  1732.     my $fh_registry = util::efopen(">$var::NMZ{'_r'}");
  1733.     @list = grep { s/(.*)/\# $1\n/ } @list;
  1734.     print $fh_registry @list;
  1735.     print $fh_registry &_("## deleted: ") . util::rfc822time(time()) . "\n\n";
  1736. }
  1737.  
  1738. sub preupdate_dateindex(@) {
  1739.     my @mtimes = @_;
  1740.  
  1741.     # Since rewriting the entire file, it is not efficient, 
  1742.     # but simple and reliable. this would be revised in the future.
  1743.     my $fh_dateindex = util::efopen(">$var::NMZ{'_t'}");
  1744. #    print "\nupdate_dateindex\n", join("\n", @mtimes), "\n\n";
  1745.     print $fh_dateindex pack("N*", @mtimes);
  1746. }
  1747.  
  1748. sub update_registry ($) {
  1749.     my ($docid_count) = @_;
  1750.  
  1751.     {
  1752.     my $fh_registry = util::efopen(">>$var::NMZ{'r'}");
  1753.     my $fh_registry_ = util::efopen($var::NMZ{'_r'});
  1754.     while (defined(my $line = <$fh_registry_>)) {
  1755.         print $fh_registry $line;
  1756.     }
  1757.     if ($docid_count > 0) {
  1758.         print $fh_registry &_("## indexed: ") . util::rfc822time(time()) . "\n\n";
  1759.     }
  1760.     }
  1761.     unlink $var::NMZ{'_r'};
  1762. }
  1763.  
  1764. sub update_dateindex () {
  1765.     util::Rename($var::NMZ{'_t'}, $var::NMZ{'t'});
  1766. }
  1767.  
  1768. sub update_field_index () {
  1769.     my @list = glob "$var::NMZ{'field'}.*.tmp";
  1770.     for my $tmp (@list) {
  1771.     if ($tmp =~ m!((^.*/NMZ\.field\.[^\.]+(?:\.i)?)\.tmp)!) {
  1772.         my $fname_tmp = $1;
  1773.         my $fname_out = $2;
  1774.         {
  1775.         my $fh_field = util::efopen(">>$fname_out");
  1776.         my $fh_tmp = util::efopen($fname_tmp);
  1777.  
  1778.         while (defined(my $line = <$fh_tmp>)) {
  1779.             print $fh_field $line;
  1780.         }
  1781.         }
  1782.         unlink $fname_tmp;
  1783.     } else {
  1784.         util::cdie(_("update_field_index: ")."@list");
  1785.     }
  1786.     }
  1787. }
  1788.  
  1789. sub pickup_updated_documents (\%) {
  1790.     my ($rdocs_ref) = @_;
  1791.     my @updated_documents = ();
  1792.  
  1793.     # To avoid duplicated outputs caused by --html-split support.
  1794.     my %printed = ();
  1795.     my $i = 0;
  1796.     for my $cfile (@{$rdocs_ref->{'name'}}) {
  1797.     if (defined($rdocs_ref->{'deleted'}{$cfile})) {
  1798.         unless ($printed{$cfile}) {
  1799.         print "$cfile " . _("was deleted!\n");
  1800.         $printed{$cfile} = 1;
  1801.         }
  1802.         $rdocs_ref->{'mtime'}[$i] = -1; # Assign the missing number.
  1803.     } elsif (defined($rdocs_ref->{'overlapped'}{$cfile})) {
  1804.         my $cfile_mtime = (stat($cfile))[9];
  1805.         my $rfile_mtime = $rdocs_ref->{'mtime'}[$i];
  1806.  
  1807.         if ($rfile_mtime != $cfile_mtime) {
  1808.         # The file is updated!
  1809.         unless ($printed{$cfile}) {
  1810.             print "$cfile " . _("was updated!\n");
  1811.             $printed{$cfile} = 1;
  1812.         }
  1813.         push(@updated_documents, $cfile);
  1814.         $rdocs_ref->{'mtime'}[$i] = -1; # Assign the missing number.
  1815.         }
  1816.     }
  1817.     $i++;
  1818.     }
  1819.  
  1820.     return @updated_documents
  1821. }
  1822.  
  1823. sub load_dateindex() {
  1824.     my $fh_dateindex = util::efopen($var::NMZ{'t'});
  1825.  
  1826.     my $size = -s $var::NMZ{'t'};
  1827.     my $buf  = "";
  1828.     read($fh_dateindex, $buf, $size);
  1829.     my @list = unpack("N*", $buf);  # load date index
  1830. #    print "\nload_dateindex\n", join("\n", @list), "\n\n";
  1831.  
  1832.     return [ @list ];
  1833. }
  1834.  
  1835. sub load_registry () {
  1836.     my $fh_registry = util::efopen($var::NMZ{'r'});
  1837.  
  1838.     my @list = ();
  1839.     my %deleted    = ();
  1840.     my @registered = ();
  1841.  
  1842.     while (defined(my $line = <$fh_registry>)) {
  1843.     chomp($line);
  1844.     next if $line =~ /^\s*$/;  # an empty line
  1845.     next if $line =~ /^##/;    # a comment
  1846.     if ($line =~ s/^\#\s+//) { # deleted document
  1847.         $deleted{$line}++;
  1848.     } else {
  1849.         # Remove HTML's anchor generated by --html-split option.
  1850.         $line =~ s/\t.*$//g;  
  1851.         push @registered, $line;
  1852.     }
  1853.     }
  1854.  
  1855.     # Exclude deleted documents.
  1856.     for my $doc (@registered) {
  1857.     if ($deleted{$doc}) {
  1858.         push @list, "# $doc";
  1859.         $deleted{$doc}--;
  1860.     } else {
  1861.         push @list, $doc;
  1862.     }
  1863.     }
  1864.  
  1865.     return [ @list ];
  1866. }
  1867.  
  1868. sub get_total_keys() {
  1869.     my $keys = get_status("keys");
  1870.     $keys = 0 unless defined $keys;
  1871.     return $keys;
  1872. }
  1873.  
  1874. sub get_total_files() {
  1875.     my $files = get_status("files");
  1876.     $files = 0 unless defined $files;
  1877.     return $files;
  1878. }
  1879.  
  1880. sub get_status($) {
  1881.     my ($key) = @_;
  1882.  
  1883.     my $fh = util::fopen($var::NMZ{'status'});
  1884.     return undef unless defined $fh;
  1885.  
  1886.     while (defined(my $line = <$fh>)) {
  1887.     if ($line =~ /^$key\s+(.*)$/) {
  1888.         util::dprint("status: $key = $1\n");
  1889.         $fh->close;
  1890.         return $1;
  1891.     }
  1892.     }
  1893.     return undef;
  1894. }
  1895.  
  1896. sub put_total_files($) {
  1897.     my ($number) = @_;
  1898.     $number =~ tr/,//d;
  1899.     put_status("files", $number);
  1900. }
  1901.  
  1902. sub put_total_keys($) {
  1903.     my ($number) = @_;
  1904.     $number =~ tr/,//d;
  1905.     put_status("keys", $number);
  1906. }
  1907.  
  1908. sub put_status($$) {
  1909.     my ($key, $value) = @_;
  1910.  
  1911.     # remove NMZ.status file if the file has a previous value.
  1912.     unlink $var::NMZ{'status'} if defined get_status($key);
  1913.  
  1914.     my $fh = util::efopen(">> $var::NMZ{'status'}");
  1915.     print $fh "$key $value\n";
  1916. }
  1917.  
  1918. # do logging
  1919. sub put_log ($$$$) {
  1920.     my ($total_files_size, $start_time, $docid_count, $total_keys_count) = @_;
  1921.  
  1922.     my $date = localtime;
  1923.     my $added_files_count   = $docid_count - $UpdatedFilesCount;
  1924.     my $deleted_documents_count = $DeletedFilesCount;
  1925.     my $updated_documents_count = $UpdatedFilesCount;
  1926.     my $total_files_count   = get_total_files() + $docid_count 
  1927.                   - $DeletedFilesCount - $UpdatedFilesCount;
  1928.     my $added_keys_count    = 0;
  1929.     $added_keys_count       = $total_keys_count - get_total_keys();
  1930.  
  1931.     my $processtime         = time - $start_time;
  1932.     $processtime            = 0 if $start_time == 0;
  1933.     $total_files_size       = $total_files_size;
  1934.     $total_keys_count       = $total_keys_count;
  1935.  
  1936.     my @logmsgs = ();
  1937.     if ($APPENDMODE) {
  1938.     push @logmsgs, N_("[Append]");
  1939.     } else {
  1940.     push @logmsgs, N_("[Base]");
  1941.     }
  1942.     push @logmsgs, N_("Date:"), "$date" if $date;
  1943.     push @logmsgs, N_("Added Documents:"), util::commas("$added_files_count")
  1944.     if $added_files_count;
  1945.     push @logmsgs, N_("Deleted Documents:"), 
  1946.     util::commas("$deleted_documents_count") if $deleted_documents_count;
  1947.     push @logmsgs, N_("Updated Documents:"), 
  1948.     util::commas("$updated_documents_count") if $updated_documents_count;
  1949.     push @logmsgs, N_("Size (bytes):"), util::commas("$total_files_size")
  1950.     if $total_files_size;
  1951.     push @logmsgs, N_("Total Documents:"), util::commas("$total_files_count") 
  1952.     if $total_files_count;
  1953.     push @logmsgs, N_("Added Keywords:"), util::commas("$added_keys_count") 
  1954.     if $added_keys_count;
  1955.     push @logmsgs, N_("Total Keywords:"), util::commas("$total_keys_count") 
  1956.     if $total_keys_count;
  1957.     push @logmsgs, N_("Wakati:"), "$conf::WAKATI" if $conf::WAKATI;
  1958.     push @logmsgs, N_("Time (sec):"), util::commas("$processtime")
  1959.     if $processtime;
  1960.     push @logmsgs, N_("File/Sec:"),  sprintf "%.2f", 
  1961.         (($added_files_count + $updated_documents_count) / $processtime) 
  1962.     if $processtime;
  1963.     push @logmsgs, N_("System:"), "$SYSTEM" if $SYSTEM;
  1964.     push @logmsgs, N_("Perl:"),   "$]" if $];   # '$]' has a perl version
  1965.     push @logmsgs, N_("Namazu:"), "$var::VERSION" if $var::VERSION;
  1966.  
  1967.     my $log_for_file = "";
  1968.  
  1969.     my $msg = shift @logmsgs;    # [Base] or [Append]
  1970.     # To stdout, use gettext.
  1971.     print _($msg), "\n";
  1972.     # To log file, do not use gettext.
  1973.     $log_for_file = $msg . "\n";
  1974.     while (@logmsgs) {
  1975.     my $field = shift @logmsgs;
  1976.     my $value = shift @logmsgs;
  1977.     printf "%-20s %s\n", _($field), "$value";
  1978.     $log_for_file .= sprintf "%-20s %s\n", $field, "$value";
  1979.     }
  1980.     print "\n";
  1981.     $log_for_file .= "\n";
  1982.  
  1983.     put_log_to_logfile($log_for_file);
  1984.     put_total_files($total_files_count);
  1985.     put_total_keys($total_keys_count);
  1986.  
  1987.     my $argv = join "\t", @ARGV;
  1988.     my $cwd  = cwd();
  1989.     put_status("argv", $argv);
  1990.     put_status("cwd",  $cwd);
  1991. }
  1992.  
  1993. sub put_log_to_logfile ($) {
  1994.     my ($logmsg) = @_;
  1995.     my $fh_logfile = util::efopen(">>$var::NMZ{'log'}");
  1996.     print $fh_logfile $logmsg;
  1997. }
  1998.  
  1999. sub get_year() {
  2000.     my $year = (localtime)[5] + 1900;
  2001.  
  2002.     return $year;
  2003. }
  2004.  
  2005. # Compose NMZ.head and NMZ.foot. Prepare samples if necessary.
  2006. # Insert $docid_count, $key_count, and $month/$day/$year respectively.
  2007. sub make_headfoot ($$$) {
  2008.     my ($file, $docid_count, $key_count) = @_;
  2009.  
  2010.     my $day   = sprintf("%02d", (localtime)[3]);
  2011.     my $month = sprintf("%02d", (localtime)[4] + 1);
  2012.     my $year  = get_year();
  2013.     my $buf   = "";
  2014.  
  2015.     if (-f $file) {
  2016.     $buf = util::readfile($file);
  2017.     } else {
  2018.     $file =~ m!.*/(.*)$!;
  2019.     my $fname = $1;
  2020.     my $template = "$TEMPLATEDIR/$fname";
  2021.  
  2022.     if (-f $template) {
  2023.         $buf = util::readfile($template);
  2024.     } else {
  2025.         return;
  2026.     }
  2027.     }
  2028.  
  2029.     my $fh_file = util::efopen(">$file");
  2030.  
  2031.     if ($buf =~ /(<!-- FILE -->)\s*(.*)\s*(<!-- FILE -->)/) {
  2032.     my $total_files_count = util::commas(get_total_files() + $docid_count 
  2033.                    - $DeletedFilesCount - $UpdatedFilesCount);
  2034.     $buf =~ s/(<!-- FILE -->)(.*)(<!-- FILE -->)/$1 $total_files_count $3/;
  2035.  
  2036.     }
  2037.     if ($buf =~ /(<!-- KEY -->)\s*(.*)\s*(<!-- KEY -->)/) {
  2038.     my $tmp = $2;
  2039.     $tmp =~ tr/,//d;
  2040.     $tmp = $key_count;
  2041.     $tmp = util::commas($tmp);
  2042.     $buf =~ s/(<!-- KEY -->)(.*)(<!-- KEY -->)/$1 $tmp $3/;
  2043.     }
  2044.     $buf =~ s#(<!-- DATE -->)(.*)(<!-- DATE -->)#$1 $year-$month-$day $3#gs;
  2045.     $buf =~ s/(<!-- VERSION -->)(.*)(<!-- VERSION -->)/$1 v$var::VERSION $3/gs;
  2046.     $buf =~ s{(<!-- ADDRESS -->)(.*)(<!-- ADDRESS -->)}
  2047.          {$1\n<a href="mailto:$conf::ADDRESS">$conf::ADDRESS</a>\n$3}gs;
  2048.     $buf =~ s{(<!-- LINK-REV-MADE -->)(.*)(<!-- LINK-REV-MADE -->)}
  2049.          {$1\n<link rev=made href="mailto:$conf::ADDRESS">\n$3}gs;
  2050.  
  2051.     print $fh_file $buf;
  2052. }
  2053.  
  2054. # Make phrase hashes for NMZ.p
  2055. # Handle two words each for calculating a hash value ranged 0-65535.
  2056. sub make_phrase_hash ($$$) {
  2057.     my ($docid_count, $docid_base, $contref) = @_;
  2058.  
  2059.     my %tmp = ();
  2060.     $$contref =~ s!\x7f */? *\d+ *\x7f!!g;  # remove tags of weight
  2061.     $$contref =~ tr/\xa1-\xfea-z0-9 \n//cd; # remove all symbols
  2062.     my @words = split(/\s+/, $$contref);
  2063.     @words = grep {$_ ne ""} @words;   # remove empty words
  2064.     my $word_b = shift @words;
  2065.     my $docid = $docid_count + $docid_base;
  2066.     for my $word (@words) {
  2067.     my $hash = hash($word_b . $word);
  2068.     unless (defined $tmp{$hash}) {
  2069.         $tmp{$hash} = 1;
  2070.         $PhraseHashLast{$hash} = 0 unless defined $PhraseHashLast{$hash};
  2071.         $PhraseHash{$hash} .= pack("w", $docid - $PhraseHashLast{$hash});
  2072. #        util::dprint("<$word_b, $word> $hash\n");
  2073.         $PhraseHashLast{$hash} = $docid;
  2074.     }
  2075.     $word_b = $word;
  2076.     }
  2077. }
  2078.  
  2079. # Construct NMZ.p and NMZ.pi file. this processing is rather complex.
  2080. sub write_phrase_hash () {
  2081.     write_phrase_hash_sub();
  2082.     util::Rename($var::NMZ{'__p'}, $var::NMZ{'_p'});
  2083.     util::Rename($var::NMZ{'__pi'}, $var::NMZ{'_pi'});
  2084. }
  2085.  
  2086. sub write_phrase_hash_sub () {
  2087.     my $opened = 0;
  2088.  
  2089.     return 0 if %PhraseHash eq "0";
  2090.     util::dprint(_("doing write_phrase_hash() processing.\n"));
  2091.  
  2092.     my $fh_tmp_pi = util::efopen(">$var::NMZ{'__pi'}");
  2093.     my $fh_tmp_p  = util::efopen(">$var::NMZ{'__p'}");
  2094.  
  2095.     my $fh_phrase = util::fopen($var::NMZ{'_p'});
  2096.     my $fh_phraseindex;
  2097.     if ($fh_phrase) {
  2098.     $fh_phraseindex = util::efopen($var::NMZ{'_pi'});
  2099.     $opened = 1;
  2100.     }
  2101.     
  2102.     my $ptr = 0;
  2103.     for (my $i = 0; $i < 65536; $i++) {
  2104.  
  2105.     my $baserecord = "";
  2106.     my $baseleng = 0;
  2107.  
  2108.     if ($opened) {
  2109.         my $tmp = 0;
  2110.         read($fh_phraseindex, $tmp, $var::INTSIZE);
  2111.         $tmp = unpack("N", $tmp);
  2112.         if ($tmp != 0xffffffff) { # 0xffffffff
  2113.         $baseleng = readw($fh_phrase);
  2114.         read($fh_phrase, $baserecord, $baseleng);
  2115.         }
  2116.     }
  2117.     if (defined($PhraseHash{$i})) {
  2118.         if ($baserecord eq "") {
  2119.         print $fh_tmp_pi pack("N", $ptr);
  2120.         my $record = $PhraseHash{$i};
  2121.         my $n2 = length($record);
  2122.         my $data = pack("w", $n2) . $record;
  2123.         print $fh_tmp_p $data;
  2124.         $ptr += length($data);
  2125.         } else {
  2126.         print $fh_tmp_pi pack("N", $ptr);
  2127.         my $record = $PhraseHash{$i};
  2128.         my $last_docid = get_last_docid($baserecord, 1);
  2129.         my $adjrecord = adjust_first_docid($record, $last_docid);
  2130.         check_records(\$record, \$baserecord, 1) unless defined $record; # namazu-bugs-ja#31
  2131.         $record = $adjrecord;
  2132.         my $n2 = length($record) + $baseleng;
  2133.         my $data = pack("w", $n2) .  $baserecord . $record;
  2134.         print $fh_tmp_p $data;
  2135.         $ptr += length($data);
  2136.         }
  2137.     } else {
  2138.         if ($baserecord eq "") {
  2139.         # if $baserecord has no data, set to 0xffffffff
  2140.         print $fh_tmp_pi pack("N", 0xffffffff);
  2141.         } else {
  2142.         print $fh_tmp_pi pack("N", $ptr);
  2143.         my $data = pack("w", $baseleng) . $baserecord;
  2144.         print $fh_tmp_p $data;
  2145.         $ptr += length($data);
  2146.         }
  2147.     }
  2148.     }
  2149.     %PhraseHash = ();
  2150.     %PhraseHashLast = ();
  2151. }
  2152.  
  2153. # Dr. Knuth's  ``hash'' from (UNIX MAGAZINE May 1998)
  2154. sub hash ($) {
  2155.     my ($word) = @_;
  2156.  
  2157.     my $hash = 0;
  2158.     for (my $i = 0; $word ne ""; $i++) {
  2159.     $hash ^= $Seed[$i & 0x03][ord($word)];
  2160.         $word = substr $word, 1;
  2161.     # $word =~ s/^.//;  is slower
  2162.     }
  2163.     return $hash & 65535;
  2164. }
  2165.  
  2166. # Count frequencies of words.
  2167. sub count_words ($$$$) {
  2168.     my ($docid_count, $docid_base, $contref, $kanji) = @_;
  2169.     my (@tmp);
  2170.  
  2171.     # Normalize into small letter.
  2172.     $$contref =~ tr/A-Z/a-z/;
  2173.  
  2174.     # Do wakatigaki if necessary.
  2175.     if (util::islang("ja")) {
  2176.     wakati::wakatize_japanese($contref) if $kanji;
  2177.     }
  2178.  
  2179.     # Remove all symbols when -K option is specified.
  2180.     $$contref =~ tr/\xa1-\xfea-z0-9/   /c if $var::Opt{'nosymbol'};
  2181.  
  2182.     my $part1 = "";
  2183.     my $part2 = "";
  2184.     if ($$contref =~ /\x7f/) {
  2185.     $part1 = substr $$contref, 0, index($$contref, "\x7f");
  2186.     $part2 = substr $$contref, index($$contref, "\x7f");
  2187. #    $part1 = $PREMATCH;  # $& and friends are not efficient
  2188. #    $part2 = $MATCH . $POSTMATCH;
  2189.     } else {
  2190.     $part1 = $$contref;
  2191.     $part2 = "";
  2192.     }
  2193.  
  2194.     # do scoring
  2195.     my %word_count = ();
  2196.     $part2 =~ s!\x7f *(\d+) *\x7f([^\x7f]*)\x7f */ *\d+ *\x7f!
  2197.     wordcount_sub($2, $1, \%word_count)!ge;
  2198.     wordcount_sub($part1, 1, \%word_count);
  2199.  
  2200.     # Add them to whole index
  2201.     my $docid = $docid_count + $docid_base;
  2202.     for my $word (keys(%word_count)) {
  2203.     next if ($word eq "" || length($word) > $conf::WORD_LENG_MAX);
  2204.     $KeyIndexLast{$word} = 0 unless defined $KeyIndexLast{$word};
  2205.     $KeyIndex{$word} .= pack("w2", 
  2206.                  $docid - $KeyIndexLast{$word}, 
  2207.                  $word_count{$word});
  2208.     $KeyIndexLast{$word} = $docid;
  2209.     }
  2210. }
  2211.  
  2212. #
  2213. # Count words and do score weighting
  2214. #
  2215. sub wordcount_sub ($$\%) {
  2216.     my ($text, $weight, $word_count) = @_;
  2217.  
  2218.     # Count frequencies of words in a current document.
  2219.     # Handle symbols as follows.
  2220.     #
  2221.     # tcp/ip      ->  tcp/ip,     tcp,      ip
  2222.     # (tcp/ip)    ->  (tcp/ip),   tcp/ip,   tcp, ip
  2223.     # ((tcpi/ip)) ->  ((tcp/ip)), (tcp/ip), tcp
  2224.     #
  2225.     # Don't do processing for nested symbols.
  2226.     # NOTE: When -K is specified, all symbols are already removed.
  2227.  
  2228.     my @words = split /\s+/, $text;
  2229.     for my $word (@words) {
  2230.     next if $word eq "";
  2231.     if ($var::Opt{'noedgesymbol'}) {
  2232.         # remove symbols at both ends
  2233.         $word =~ s/^[^\xa1-\xfea-z_0-9]*(.*?)[^\xa1-\xfea-z_0-9]*$/$1/g;
  2234.     }
  2235.     $word_count->{$word} = 0 unless defined($word_count->{$word});
  2236.     $word_count->{$word} += $weight;
  2237.     unless ($var::Opt{'nosymbol'}) {
  2238.         if ($word =~ /^[^\xa1-\xfea-z_0-9](.+)[^\xa1-\xfea-z_0-9]$/) {
  2239.         $word_count->{$1} = 0 unless defined($word_count->{$1});
  2240.         $word_count->{$1} += $weight;
  2241.         next unless $1 =~ /[^\xa1-\xfea-z_0-9]/;
  2242.         } elsif ($word =~ /^[^\xa1-\xfea-z_0-9](.+)/) {
  2243.         $word_count->{$1} = 0 unless defined($word_count->{$1});
  2244.         $word_count->{$1} += $weight;
  2245.         next unless $1 =~ /[^\xa1-\xfea-z_0-9]/;
  2246.         } elsif ($word =~ /(.+)[^\xa1-\xfea-z_0-9]$/) {
  2247.         $word_count->{$1} = 0 unless defined($word_count->{$1});
  2248.         $word_count->{$1} += $weight;
  2249.         next unless $1 =~ /[^\xa1-\xfea-z_0-9]/;
  2250.         }
  2251.         my @words_ = split(/[^\xa1-\xfea-z_0-9]+/, $word)
  2252.         if $word =~ /[^\xa1-\xfea-z_0-9]/;
  2253.         for my $tmp (@words_) {
  2254.         next if $tmp eq "";
  2255.         $word_count->{$tmp} = 0 unless defined($word_count->{$tmp});
  2256.         $word_count->{$tmp} += $weight;
  2257.         }
  2258.         @words_ = ();
  2259.     }
  2260.     }
  2261.     return "";
  2262. }
  2263.  
  2264. # Construct NMZ.i and NMZ.ii file. this processing is rather complex.
  2265. sub write_index () {
  2266.     my $key_count = write_index_sub();
  2267.     util::Rename($var::NMZ{'__i'}, $var::NMZ{'_i'});
  2268.     util::Rename($var::NMZ{'__w'}, $var::NMZ{'_w'});
  2269.  
  2270.     return $key_count;
  2271. }
  2272.  
  2273. # readw: read one pack 'w' word.
  2274. # This code was contributed by <furukawa@tcp-ip.or.jp>.
  2275. sub readw ($) {
  2276.     my $fh = shift;
  2277.     my $ret = '';
  2278.     my $c;
  2279.     
  2280.     while (read($fh, $c, 1)){
  2281.     $ret .= $c;
  2282.     last unless 0x80 & ord $c;
  2283.     }
  2284.     return unpack('w', $ret);
  2285. }
  2286.  
  2287. sub get_last_docid ($$) {
  2288.     my ($record, $step) = @_;
  2289.     my (@data) = unpack 'w*', $record;
  2290.  
  2291.     my $sum = 0;
  2292.     for (my $i = 0; $i < @data; $i += $step) {
  2293.     $sum += $data[$i];
  2294.     }
  2295.     my $leng = @data / $step;
  2296.     return $sum;
  2297. }
  2298.  
  2299. sub adjust_first_docid ($$) {
  2300.     my ($record, $last_docid) = @_;
  2301.     my (@data) = unpack 'w*', $record;
  2302.  
  2303.     $data[0] = $data[0] - $last_docid;
  2304.     return undef if ($data[0] < 0); # namazu-bug-ja#31
  2305.     $record = pack 'w*', @data;
  2306.     return $record;
  2307. }
  2308.  
  2309. sub write_index_sub () {
  2310.     my @words = sort keys(%KeyIndex);
  2311.     return 0 if $#words == -1;
  2312.  
  2313.     my $cnt = 0;
  2314.     my $ptr_i = 0;
  2315.     my $ptr_w = 0;
  2316.     my $key_count = 0;
  2317.     my $baserecord = "";
  2318.  
  2319.     util::dprint(_("doing write_index() processing.\n"));
  2320.     my $fh_tmp_i  = util::efopen(">$var::NMZ{'__i'}");
  2321.     my $fh_tmp_w  = util::efopen(">$var::NMZ{'__w'}");
  2322.     my $fh_i      = util::fopen($var::NMZ{'_i'});
  2323.     my $fh_ii     = util::efopen(">$var::NMZ{'_ii'}");
  2324.     my $fh_w      = util::fopen($var::NMZ{'_w'});
  2325.     my $fh_wi = util::efopen(">$var::NMZ{'_wi'}");
  2326.  
  2327.     if ($fh_w) {
  2328.       FOO:
  2329.     while (defined(my $line = <$fh_w>)) {
  2330.         chop $line;
  2331.         my $current_word = $line;
  2332.  
  2333.         my $baseleng = readw($fh_i);
  2334.         read($fh_i, $baserecord, $baseleng);
  2335.  
  2336.          for (; $cnt < @words; $cnt++) {
  2337.         last unless $words[$cnt] le $current_word;
  2338.         my $record = $KeyIndex{$words[$cnt]};
  2339.         my $leng = length($record);
  2340.  
  2341.         if ($current_word eq $words[$cnt]) {
  2342.             my $last_docid = get_last_docid($baserecord, 2);
  2343.             my $adjrecord = adjust_first_docid($record, $last_docid);
  2344.             check_records(\$record, \$baserecord, 2) unless defined $record; # namazu-bugs-ja#31
  2345.             $record = $adjrecord;
  2346.             $leng = length($record);  # re-measure
  2347.             my $tmp = pack("w", $leng + $baseleng);
  2348.  
  2349.             my $data_i = "$tmp$baserecord$record";
  2350.             my $data_w = "$current_word\n";
  2351.             print $fh_tmp_i $data_i;
  2352.             print $fh_tmp_w $data_w;
  2353.             print $fh_ii pack("N", $ptr_i);
  2354.             print $fh_wi pack("N", $ptr_w);
  2355.             $ptr_i += length($data_i);
  2356.             $ptr_w += length($data_w);
  2357.             $key_count++;
  2358.  
  2359.             $cnt++;
  2360.             next FOO;
  2361.         } else {
  2362.             my $tmp = pack("w", $leng);
  2363.             my $data_i = "$tmp$record";
  2364.             my $data_w = "$words[$cnt]\n";
  2365.             print $fh_tmp_i $data_i;
  2366.             print $fh_tmp_w $data_w;
  2367.             print $fh_ii pack("N", $ptr_i);
  2368.             print $fh_wi pack("N", $ptr_w);
  2369.             $ptr_i += length($data_i);
  2370.             $ptr_w += length($data_w);
  2371.             $key_count++;
  2372.         }
  2373.         }
  2374.         my $tmp  = pack("w", $baseleng);
  2375.         my $data_i = "$tmp$baserecord";
  2376.         my $data_w = "$current_word\n";
  2377.         print $fh_tmp_i $data_i;
  2378.         print $fh_tmp_w $data_w;
  2379.         print $fh_ii pack("N", $ptr_i);
  2380.         print $fh_wi pack("N", $ptr_w);
  2381.         $ptr_i += length($data_i);
  2382.         $ptr_w += length($data_w);
  2383.         $key_count++;
  2384.     }
  2385.     }
  2386.     while ($cnt < @words) {
  2387.     my $leng = length($KeyIndex{$words[$cnt]});
  2388.     my $tmp = pack("w", $leng);
  2389.     my $record = $KeyIndex{$words[$cnt]};
  2390.  
  2391.     my $data_i = "$tmp$record";
  2392.     my $data_w = "$words[$cnt]\n";
  2393.     print $fh_tmp_i $data_i;
  2394.     print $fh_tmp_w $data_w;
  2395.     print $fh_ii pack("N", $ptr_i);
  2396.     print $fh_wi pack("N", $ptr_w);
  2397.     $ptr_i += length($data_i);
  2398.     $ptr_w += length($data_w);
  2399.     $key_count++;
  2400.     $cnt++;
  2401.     }
  2402.     %KeyIndex = ();
  2403.     %KeyIndexLast = ();
  2404.  
  2405.     return $key_count;
  2406. }
  2407.  
  2408. #
  2409. # Decide the media type. 
  2410. # FIXME: Very ad hoc. It's just a compromise. -- satoru
  2411. #
  2412. sub decide_type ($$) {
  2413.     my ($name, $cont) = @_;
  2414.     return $name if (!defined $cont || $name eq $cont);
  2415.  
  2416.     util::dprint("decide_type: name: $name, cont: $cont\n");
  2417.     if ($cont =~ m!^text/plain! && $name =~ m!^text/plain!) {
  2418.     return $name;
  2419.     } elsif ($cont =~ m!^application/octet-stream!) {
  2420.     return $name;
  2421.     } elsif ($cont =~ m!^application/(excel|powerpoint|msword)! &&
  2422.          $name !~ m!^application/octet-stream!)  {
  2423.     # FIXME: Currently File::MMagic 1.02's checktype_data() 
  2424.     # is unreliable for them.
  2425.     return $name;
  2426.     }
  2427.  
  2428.     return $cont;
  2429. }
  2430.  
  2431. #
  2432. # Debugging code for the "negative numbers" problem.
  2433. #
  2434. sub check_records ($$$) {
  2435.     my ($recref, $baserecref, $step) = @_;
  2436.     dump_record($baserecref, $step);
  2437.     dump_record($recref, $step);
  2438.     print STDERR "The \x22negative number\x22 problem occurred.\n";
  2439.     exit(1);
  2440. }
  2441.  
  2442. sub dump_record($$) {
  2443.     my ($recref, $step) = @_;
  2444.     my (@data) = unpack 'w*', $$recref;
  2445.     print STDERR "dump record data to NMZ.bug.info (step: $step)...";
  2446.     my $fh_info = util::fopen(">> NMZ.bug.info");
  2447.     print $fh_info "dumped record data (step: $step)...";
  2448.     foreach (@data) {
  2449.     print $fh_info sprintf(" %08x", $_);
  2450.     }
  2451.     print $fh_info "\n";
  2452.     return;
  2453. }
  2454.  
  2455. #
  2456. # For avoiding "used only once: possible typo at ..." warnings.
  2457. #
  2458. muda($conf::ON_MEMORY_MAX,
  2459.      $conf::WORD_LENG_MAX, $conf::TEXT_SIZE_MAX,
  2460.      $conf::DENY_FILE, $var::INTSIZE,
  2461.      $conf::CHASEN_NOUN, $conf::CHASEN,
  2462.      $conf::KAKASI, $var::Opt{'okurigana'},
  2463.      $var::Opt{'hiragana'}, $conf::DIRECTORY_INDEX,
  2464.      $usage::USAGE, $var::Opt{'noheadabst'}, $usage::VERSION_INFO,
  2465.      $var::Opt{'noencodeurl'}, $conf::HTML_SUFFIX,
  2466.      $var::RECURSIVE_ACTIONS, $conf::META_TAGS, $var::USE_NKF_MODULE,
  2467.      $conf::ADDRESS, $var::MAILING_ADDRESS,
  2468.      $conf::FILE_SIZE_MAX,
  2469.      );
  2470.  
  2471. sub muda {}
  2472.  
  2473.